_Boroda_, Спасибо, я видел на форуме, но почему-то там больше расширяется строки, чем надо. Иногда намного больше. anvg, спасибо за ссылку, тут тоже больше появляется места.
Не пойму почему.
_Boroda_, Спасибо, я видел на форуме, но почему-то там больше расширяется строки, чем надо. Иногда намного больше. anvg, спасибо за ссылку, тут тоже больше появляется места.
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]
Из личных архивов [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