Из личных архивов
[vba]Код
Private Sub MyMaxRow(): Call MySameRow("MaxRow"): End Sub
Private Sub MyMinRow(): Call MySameRow("MinRow"): End Sub
Private Sub MySameRow(Optional equal As String = "SameRow")
' Макрос записан 21.11.2017 (boa)
' Делает высоту строк одинаковой
Dim Row As Range, i As Double
For Each Row In Selection.Rows
Select Case equal
Case "MaxRow": If i < Row.RowHeight Then i = Row.RowHeight
Case "MinRow": If Row.RowHeight < i Or i = 0 Then i = Row.RowHeight
Case "SameRow": i = i + Row.RowHeight
End Select
Next
If equal = "SameRow" Then i = i / Selection.Rows.Count
For Each Row In Selection.Rows
Row.RowHeight = i
Next
End Sub
Private Sub MyMaxCol(): Call MySameCol("MaxCol"): End Sub
Private Sub MyMinCol(): Call MySameCol("MinCol"): End Sub
Private Sub MySameCol(Optional equal As String = "SameCol")
' Макрос записан 21.11.2017 (boa)
' Делает ширину колонок одинаковой.
Dim Col As Range, i As Double
For Each Col In Selection.Columns
Select Case equal
Case "MaxCol": If i < Col.ColumnWidth Then i = Col.ColumnWidth
Case "MinCol": If Col.ColumnWidth < i Or i = 0 Then i = Col.ColumnWidth
Case "SameCol": i = i + Col.ColumnWidth
End Select
Next
If equal = "SameCol" Then i = i / Selection.Columns.Count
For Each Col In Selection.Columns
Col.ColumnWidth = i
Next
End Sub
[/vba]