Вставка разрыва страниц перед заданным значением |
|
|
Автор Administrator
|
23.04.2010 г. |
Макрос для Excel. Функция ищет заданное значение, вставляет разрыв страницы перед ним, меняет цвет найденной строки, скрывает строку.
Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim FirstAddress As String Dim MyAddress As String Dim MySearch As Variant Dim myColor As Variant Dim Rng As Range Dim I As Long 'удаляет все разрывы страниц ActiveSheet.ResetAllPageBreaks 'отображает все скрытые строки ActiveSheet.Rows("1:65536").EntireRow.Hidden = False 'Fill in the search Value and color Index MySearch = Array("---break---") myColor = Array("3") 'You can also use more values in the Array 'MySearch = Array("ron", "jelle", "judith") 'myColor = Array("3", "6", "10") 'Fill in the Search range, for the whole sheet use 'you can use Sheets("Sheet1").Cells With Sheets("Sheet1").Range("A1:A65536") 'Change the fill color to "no fill" in all cells .Interior.ColorIndex = xlColorIndexNone For I = LBound(MySearch) To UBound(MySearch) 'If you want to find a part of the rng.value then use xlPart 'if you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to MySearch(I) Set Rng = .Find(What:=MySearch(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do ' Закрашивает красным Rng.Interior.ColorIndex = myColor(I) ' Добавляет разделитель ActiveSheet.HPageBreaks.Add Before:=Rng ' Скрывает строку MyAddress = Rng.Address MyAddress = Right(MyAddress, Len(MyAddress) - 3) ActiveSheet.Rows(MyAddress).EntireRow.Hidden = True Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With End Sub Просмотров: 12442
Ваш коментарий будет первым | | |