Функция ищет заданное значение, вставляет разрыв страницы перед ним, меняет цвет найденной строки, скрывает строку.
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
Просмотров: 12268
 Ваш коментарий будет первым |
 |
| Добавить коментарий |