Sub Высота_строк() Dim i As Long, rng As Range For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i)) End If Next i If Not rng Is Nothing Then rng.RowHeight = 15 End Sub
[/vba]
куда припилить Application.Dialogs(xlDialogRowHeight).Show чтоб задать высоту через диалоговое окно?
Добрый день, подскажите пожалуйста
[vba]
Код
Sub Высота_строк() Dim i As Long, rng As Range For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i)) End If Next i If Not rng Is Nothing Then rng.RowHeight = 15 End Sub
[/vba]
куда припилить Application.Dialogs(xlDialogRowHeight).Show чтоб задать высоту через диалоговое окно?Gjlhzl
Sub Высота_строк() Dim i As Long, rng As Range, ac As Range For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i)) End If Next i 'If Not rng Is Nothing Then rng.RowHeight = 15 If Not rng Is Nothing Then Set ac = Selection 'запоминание активного выделения (ячейки) перед выполнением rng.Select Application.SendKeys "15" 'значение по умолчанию для диалога Application.Dialogs(xlDialogRowHeight).Show ac.Select 'восстановление активного выделения (ячейки) после выполнения End If End Sub
[/vba]
Здравствуйте! В последний If и припилить:
[vba]
Код
Sub Высота_строк() Dim i As Long, rng As Range, ac As Range For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i)) End If Next i 'If Not rng Is Nothing Then rng.RowHeight = 15 If Not rng Is Nothing Then Set ac = Selection 'запоминание активного выделения (ячейки) перед выполнением rng.Select Application.SendKeys "15" 'значение по умолчанию для диалога Application.Dialogs(xlDialogRowHeight).Show ac.Select 'восстановление активного выделения (ячейки) после выполнения End If End Sub
Тогда можно попробовать принципиально иной подход. Запрос высоты строки сделать перед циклом, через InputBox вместо DialogBox. А высоты строк менять по одной, не объединяя их перед операцией. Похоже, именно предварительное объединение нужных строк мешает при наличии объединенных ячеек. [vba]
Код
Sub Высота_строк_2() Dim i As Long, rh As Double, ac As Range Set ac = Selection 'запоминание активного выделения (ячейки) перед выполнением rh = CDbl(Application.InputBox("Высота строки:", "Высота строки")) Application.ScreenUpdating = False For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then Rows(i).RowHeight = rh End If Next i Application.ScreenUpdating = True ac.Select 'восстановление активного выделения (ячейки) после выполнения End Sub
Тогда можно попробовать принципиально иной подход. Запрос высоты строки сделать перед циклом, через InputBox вместо DialogBox. А высоты строк менять по одной, не объединяя их перед операцией. Похоже, именно предварительное объединение нужных строк мешает при наличии объединенных ячеек. [vba]
Код
Sub Высота_строк_2() Dim i As Long, rh As Double, ac As Range Set ac = Selection 'запоминание активного выделения (ячейки) перед выполнением rh = CDbl(Application.InputBox("Высота строки:", "Высота строки")) Application.ScreenUpdating = False For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 8) = "*" Then Rows(i).RowHeight = rh End If Next i Application.ScreenUpdating = True ac.Select 'восстановление активного выделения (ячейки) после выполнения End Sub