Problema con autoajuste de celdas combinadas
Tengo un Botón que se supone debería autoajustar el alto de fila en el rango B2 a B70 ya que el texto introducido aquí siempre es variable, tengo la siguiente rutina la cual debería hacer esto con la ayuda de otra hoja llamada "nada":
Private Sub CommandButton1_Click()
Dim obj_Cell As Range
Dim Ancho As Double
For I = 16 To 70
m = Range("B" & 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("NADA")
.[A1].ColumnWidth = Ancho
.[A1].Value = Range("B" & I & "")
.Rows(1).EntireRow.AutoFit
Range("B" & I & "").RowHeight = .[A1].RowHeight
End With
Next I
End Sub
Y pues el problema es que ajusta solo algunas celdas, y con las demás hace un desastre, dando altos exagerados en als filas... Si alguien pudiera decirme que modificar para que funcione correctamente, estaría eternamente agradecido. El código lo conseguí en algún otro foro... Solo le modifique algunos datos.
Private Sub CommandButton1_Click()
Dim obj_Cell As Range
Dim Ancho As Double
For I = 16 To 70
m = Range("B" & 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("NADA")
.[A1].ColumnWidth = Ancho
.[A1].Value = Range("B" & I & "")
.Rows(1).EntireRow.AutoFit
Range("B" & I & "").RowHeight = .[A1].RowHeight
End With
Next I
End Sub
Y pues el problema es que ajusta solo algunas celdas, y con las demás hace un desastre, dando altos exagerados en als filas... Si alguien pudiera decirme que modificar para que funcione correctamente, estaría eternamente agradecido. El código lo conseguí en algún otro foro... Solo le modifique algunos datos.
1 Respuesta
Respuesta de jrgces
2
Yo tengo escrito código para hacer más o menos eso (creo). Si quieres puedes ver si te serviría para adaptarlo a lo que necesites: http://www.jrgc.es/ejemplos/AjustarTextoEnCeldasCombinadas.xls
Hola saludos, gracias por la pronta respuesta. Ya había probado con ese código el problema es que mi rango de celdas esta vinculado a una base de datos, y por lo que entiendo esta rutina ajusta automáticamente al modificar la celda, entonces al momento de cambiar los datos de la base de datos, ¿tendría qué editar todo mi rango de celdas?
No tengo idea como podría adaptarlo para que lo haga a través de un botón, e indicando el rango de celdas a autoajustar, ya que no es toda la hoja...
Saludos¡
No tengo idea como podría adaptarlo para que lo haga a través de un botón, e indicando el rango de celdas a autoajustar, ya que no es toda la hoja...
Saludos¡
Puedes llamar al sub AjustarTextoEnCeldasCombinadas pasándole como argumento la propiedad MergeArea de la celda o celdas que quieres procesar.
Por ejemplo, si en Hoja1 las celdas A1 a A10 están cada una de ellas combinadas con las celdas a su derecha, el código para procesarlas todas sería:
Sub AjustarA1_A10()
Dim rngC As Range
For Each rngC In [Hoja1!A1:A10]
AjustarTextoEnCeldasCombinadas rngC.MergeArea
Next rngC
End Sub
Sub AjustarTextoEnCeldasCombinadas(rngRango As Range)
'Este sub cambiará la altura de la fila que tenga las celdas combinadas para que el texto & _
que tengan sea visible sin cambiar el ancho de las columnas.
If rngRango.Rows.Count <> 1 Then
MsgBox prompt:="El rango a ajustar no puede tener más de una fila.", Buttons:=vbCritical + vbOKOnly
Exit Sub
End If
Dim sngAnchoTotal As Single, sngAnchoCelda As Single, sngAlto As Single
Dim n As Integer
For n = 1 To rngRango.Columns.Count
sngAnchoTotal = sngAnchoTotal + rngRango.Cells(1, n).ColumnWidth
Next n
Application.ScreenUpdating = False
With rngRango.Cells(1, 1)
sngAnchoCelda = .ColumnWidth
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlJustify
.MergeCells = False
.ColumnWidth = sngAnchoTotal
rngRango.Parent.Rows(rngRango.Row).AutoFit
sngAlto = .RowHeight
End With
With rngRango
.Merge
.Columns(1).EntireColumn.ColumnWidth = sngAnchoCelda
.Columns(1).RowHeight = sngAlto
End With
Application.ScreenUpdating = True
End Sub
Lógicamente, el sub a ejecutar en este caso sería AjustarA1_A10.
Por ejemplo, si en Hoja1 las celdas A1 a A10 están cada una de ellas combinadas con las celdas a su derecha, el código para procesarlas todas sería:
Sub AjustarA1_A10()
Dim rngC As Range
For Each rngC In [Hoja1!A1:A10]
AjustarTextoEnCeldasCombinadas rngC.MergeArea
Next rngC
End Sub
Sub AjustarTextoEnCeldasCombinadas(rngRango As Range)
'Este sub cambiará la altura de la fila que tenga las celdas combinadas para que el texto & _
que tengan sea visible sin cambiar el ancho de las columnas.
If rngRango.Rows.Count <> 1 Then
MsgBox prompt:="El rango a ajustar no puede tener más de una fila.", Buttons:=vbCritical + vbOKOnly
Exit Sub
End If
Dim sngAnchoTotal As Single, sngAnchoCelda As Single, sngAlto As Single
Dim n As Integer
For n = 1 To rngRango.Columns.Count
sngAnchoTotal = sngAnchoTotal + rngRango.Cells(1, n).ColumnWidth
Next n
Application.ScreenUpdating = False
With rngRango.Cells(1, 1)
sngAnchoCelda = .ColumnWidth
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlJustify
.MergeCells = False
.ColumnWidth = sngAnchoTotal
rngRango.Parent.Rows(rngRango.Row).AutoFit
sngAlto = .RowHeight
End With
With rngRango
.Merge
.Columns(1).EntireColumn.ColumnWidth = sngAnchoCelda
.Columns(1).RowHeight = sngAlto
End With
Application.ScreenUpdating = True
End Sub
Lógicamente, el sub a ejecutar en este caso sería AjustarA1_A10.
Mi hermano, he realizado un par de cambios y ha funcionado perfectamente, tiempo ahorrado realizando esta tediosa tarea, como dije, tienes mi eterno agradecimiento, gracias por la pronta respuesta. Saludos desde Oaxaca Mexico.
Gracias¡
Gracias¡
Muy ingeniosa tu Solución... mis más sinceras felicitaciones, Muchas gracias me ayudó muchísimo - Julio Cesar Buitrago Morales