you can try this macro...(there could be better solutions) ;adjust elements in red to fit:
Sub getFontsize()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 15
Rows(i).Select
Selection.RowHeight = 2 * (ActiveSheet.Cells(i, 1).Font.Size + 5)
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
If Len(ActiveSheet.Cells(i, 1)) > 30 Then
.Rows.AutoFit
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Attention: if you use merged cells, or if your cells containing formulas, it will not work properly
|