Rambler's Top100
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
 
Главная arrow MS ACCESS arrow Вставка разрыва страниц перед заданным значением
Вставка разрыва страниц перед заданным значением Печать E-mail
Автор 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

  Ваш коментарий будет первым

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList