View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
sebastienm sebastienm is offline
external usenet poster
 
Posts: 694
Default Autofit doesn't work when column not enough width

Hi,
Try to expand the row height to a large number before autofit, eg:
Rg.EntireRow.RowHeight=400
Rg.EntireRow.Autofit

--
Regards,
Sébastien
<http://www.ondemandanalysis.com


"Alex St-Pierre" wrote:

Hi !
I have modify the original "AdjustRowHeight" for merged cells to apply to
all cells in a specific table range. Sometimes, when column width are not
enought large, the EntireRow.AutoFit command doesn't work. Does anyone have a
solution for this kind of problem ?
Is it possible to have a macro that replace the Autofit line ?
What I could do is to enlarge each table column (+1), make autofit and then,
resize column width to original value.

Excel seems to required a little space after the end of the last character.

Thank you.

Here is my program.
Sub AdjustRowHeight()
Dim myRange As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim j As Long
Dim myCell As Cells

'1- Verify if there is a table in the ActiveSheet
myTable = Array("table1_1", "table1_2", "table2_1", "table2_2", "table2_3",
"table3_1", "table3_2")
On Error Resume Next
i = -1
Do Until Not myRange Is Nothing Or i = 7
i = i + 1
Set myRange = ActiveSheet.Range(myTable(i)) 'Local Range Only
Loop
If i = 7 Then Exit Sub

'2- Adjust Row Height
myRange.EntireRow.AutoFit = True
For Each cell In myRange
MergedCellRgWidth = 0
If cell.MergeCells And cell = cell.MergeArea.Cells(1) Then 'Treatment
for first merge cell only
With cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = cell.ColumnWidth
For Each CurrCell In cell.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next cell
End Sub
--
Alex St-Pierre