............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Ayuda con macro para ajustar altura de celdas combinadas

Ver el tema anterior Ver el tema siguiente Ir abajo

Ayuda con macro para ajustar altura de celdas combinadas

Mensaje por pedrosilv el Miér Ago 11, 2010 3:10 pm

Buena tarde compañeros foristas.

Quisiera consultarles lo siguiente. Tengo la siguiente macro que ajusta la altura de celdas combinadas y no combinadas para las primeras 7 filas de la columna A.

Código:
Private Sub CommandButton1_Click()

    Dim obj_Cell As Range
    Dim Ancho As Double
   
    For i = 1 To 7
        m = Range("A" & i & "").MergeArea.Address
        Ancho = 0
        For Each obj_Cell In Range(m)
            With obj_Cell
                Ancho = Ancho + obj_Cell.ColumnWidth
            End With
        Next
        With Sheets("Hoja3")
            .[a1].ColumnWidth = Ancho
            .[a1].Value = Range("A" & i & "")
            .Rows(1).EntireRow.AutoFit
            Range("A" & i & "").RowHeight = .[a1].RowHeight
        End With
    Next i

Lo que quiero saber, es cómo indicar para que la macro me ajuste por ejemplo, solo ciertas filas, por ejemplo, la fila A5, A9, A10, A17, A19 siempre en la hoja1?

Agradecería eternamente si me pudieran ayudar con esto.

Saludos desde Guatemala.

Att. Pedro Silvestre
avatar
pedrosilv

Masculino Cantidad de envíos : 85
Edad : 32
Ciudad - Pais : Guatemala
Version de Excel : 2003-2007
Fecha de inscripción : 16/04/2009

Volver arriba Ir abajo

Re: Ayuda con macro para ajustar altura de celdas combinadas

Mensaje por Alejandro62 el Sáb Ago 14, 2010 11:52 pm

Hola Pedro,
Seleccionas las ciertas celdas con el mouse y/o manualmente y despues corres esta macro:

Private Sub CommandButton1_Click()

Dim obj_Cell As Range
Dim Ancho As Double

For Each celda In Selection
m = celda.MergeArea.Address
Ancho = 0
For Each obj_Cell In Range(m)
With obj_Cell
Ancho = Ancho + obj_Cell.ColumnWidth
End With
Next
With Sheets("Hoja3")
.[a1].ColumnWidth = Ancho
.[a1].Value = celda
.Rows(1).EntireRow.AutoFit
celda.RowHeight = .[a1].RowHeight
End With
Next
End sub

Saludos.


Alejandro62

Masculino Cantidad de envíos : 37
Edad : 55
Ciudad - Pais : Mexico, Estado de Mexico
Version de Excel : Excel 2010
Fecha de inscripción : 21/11/2009

Volver arriba Ir abajo

Re: Ayuda con macro para ajustar altura de celdas combinadas

Mensaje por pedrosilv el Miér Sep 08, 2010 8:07 pm

Hola alejandro, Gracias por la sugerencia, aunque no pude ejecutar lo que me indicas.

Y siempre buscando algo relacionado al tema, encontre la siguiente macro, que supuestamente ajusta automáticamente las filas y columnas combinadas, sin embargo no he podido hacerla funcionar. Agradecería de nuevo si me pudieran tender una mano.

Muchas gracias.

Código:
Sub SetRowHeights(Sh As Object)
' Establece la altura de las filas en la hoja Sh.
' Excel no ajusta correctamente la altura de las filas cuando las celdas estan combinadas
  Dim C As Range, rRow As Range
  Dim sHeight As Single
  Dim sBestHeight As Single
  Dim bUpdate As Boolean
  Dim bHid As Boolean
  Dim iHidCol As Integer
  Dim cSizer As Range
 
  ' apagar la pantalla de actualización para acelerar el proceso
  bUpdate = Application.ScreenUpdating
  Application.ScreenUpdating = False
 
 
  ' este proceso solo es relavante para hojas de cálculo, no para hojas de gráficos
  If TypeName(Sh) = "Worksheet" Then
    If IsNull(Sh.UsedRange.WrapText) Or Sh.UsedRange.WrapText Then
      ' ajuste de texto en celdas de la hoja temporal
      Workbooks.Add xlWorksheet ' libro temporal
      Set cSizer = Range("A1")  ' esta es la celda utilizada como espacio de trabajo
   
      For Each rRow In Sh.UsedRange.Rows
        If IsNull(rRow.WrapText) Or rRow.WrapText Then
          ' copiar el contenido de la celda a otra donde no se ha autoajustado
          If Not IsNull(rRow.MergeCells) Then
            ' hay celdas de esta fila con el texto fusionado
            rRow.EntireRow.AutoFit
          Else
            ' celdas combinadas y texto autoajustado
            sBestHeight = 12.75
            For Each C In rRow.Cells
              ' copiar el contenido de la celda a otra donde no se ha autoajustado
              If C.Address = C.MergeArea.Range("A1").Address _
                  And C.WrapText And Not C.EntireColumn.Hidden Then
                ' la primera fila de una celda combinada, o una sola celda, envuelta con el texto
                ' y columna no oculta
                ' conjunto de la celda individual en términos a coincidir con la celda fusionada acá
                cSizer.Value = C.Text
                cSizer.Font.Size = C.Font.Size
                cSizer.Font.Bold = C.Font.Bold
                ' el ancho se mide en Twips y podemos encontrar el ancho del area combinada
                ' pero solo podemos establecer el ColumnWidth que se mide en unidades distintas
                ' para obtener el ancho adecuadao
                cSizer.EntireColumn.ColumnWidth = C.MergeArea.Width * cSizer.ColumnWidth / cSizer.Width
                cSizer.WrapText = True
                ' utilizar autoajustar para encontrar la altura de la fila que se encuentra a la derecha de esta
                cSizer.EntireRow.AutoFit
                ' obtener la altura
                sHeight = cSizer.RowHeight
                ' si la celdas se combina verticalmente, entonces necesitamos menor altura que este
                If C.MergeArea.Rows.Count > 1 Then
                  ' ajustar la altura de las filas siguientes
                  sHeight = sHeight - (C.MergeArea.Rows.Count - 1) * (C.Font.Size + 2.75)
                End If
              Else
                sHeight = C.Font.Size + 2.75
              End If
              ' tomar la altura mayor del grupo de celdas combinadas
              If sHeight > sBestHeight Then sBestHeight = sHeight
            Next
            ' si la fila no tiene la altura correcta
            If rRow.EntireRow.RowHeight <> sBestHeight Then
              ' ponerlo a la altura correcta
              rRow.EntireRow.RowHeight = sBestHeight
            End If
          End If
        End If
      Next
      ' cerrar el libro auxiliar
      ActiveWorkbook.Close False
    End If
  End If
  ' reestablecer screenupdating a su estado original
  Application.ScreenUpdating = bUpdate
End Sub


' se puede llamar de la siguiente forma
'SetRowHeights ThisWorkbook.Worksheets("Whatever The Worksheet Is Called")
avatar
pedrosilv

Masculino Cantidad de envíos : 85
Edad : 32
Ciudad - Pais : Guatemala
Version de Excel : 2003-2007
Fecha de inscripción : 16/04/2009

Volver arriba Ir abajo

Re: Ayuda con macro para ajustar altura de celdas combinadas

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.