AddSAPage - Добавляет страницу САПР-АСУ если ее нет, добавляет еще, если подобные уже есть В строке передается имя страницы, возвращаем что создали

Oformlenie.bas

Function AddSAPage(PageName As String) As Visio.Page
'------------------------------------------------------------------------------------------------------------
' Function        : AddSAPage - Добавляет страницу САПР-АСУ если ее нет, добавляет еще, если подобные уже есть
                  'В строке передается имя страницы, возвращаем что создали
'------------------------------------------------------------------------------------------------------------
    Dim vsoPage As Visio.Page
    Dim colPages As Collection
    Dim Ramka As Visio.Master
    Dim shpRamka As Visio.Shape
    Dim Npage As Integer
    Dim MaxNumber As Integer
    Dim MaxNpage As Integer
    
    Set Ramka = Application.Documents.Item("SAPR_ASU_OFORM.vss").Masters.Item("Рамка")
    Set colPages = New Collection
    
    For Each vsoPage In ActiveDocument.Pages
        If vsoPage.Name Like PageName & "*" Then
            colPages.Add vsoPage
        End If
    Next
    
    If colPages.Count = 0 Then
        'Создаем первую страницу
        Set vsoPage = ActiveDocument.Pages.Add
        vsoPage.Name = PageName
        Set shpRamka = vsoPage.Drop(Ramka, 0, 0)
        ActiveDocument.Masters.Item("Рамка").Delete
        shpRamka.Cells("Prop.CHAPTER").FormulaU = "INDEX(0,Prop.CHAPTER.Format)"

    Else
        'Ищем номер последней страницы
        MaxNumber = MaxMinPageNumber(colPages)

        If MaxNumber = 1 Then 'Создаем вторую страницу
            Set vsoPage = ActiveDocument.Pages.Add
            vsoPage.Name = PageName & ".2"
            
        Else 'Создаем последующие страницы
            'Находим максимальный номер страницы в NameU и Name
            MaxNpage = MaxMinPageNumber(colPages, , , True)
            'Создаем страницу раздела с максимальным номером
            Set vsoPage = ActiveDocument.Pages.Add
            vsoPage.Name = PageName & "." & CStr(MaxNpage + 1)
            'Переименовываем вставленный лист в нумерацию Name после текущего
            vsoPage.Name = PageName & "." & CStr(MaxNumber + 1)
        End If
        
        Set shpRamka = vsoPage.Drop(Ramka, 0, 0)
        ActiveDocument.Masters.Item("Рамка").Delete
        shpRamka.Cells("Prop.CHAPTER").FormulaU = "INDEX(1,Prop.CHAPTER.Format)"

    End If
    shpRamka.Cells("Prop.CNUM") = 0
    shpRamka.Cells("Prop.TNUM") = 0
    vsoPage.PageSheet.Cells("PageWidth").Formula = "420 MM"
    vsoPage.PageSheet.Cells("PageHeight").Formula = "297 MM"
    vsoPage.PageSheet.Cells("Paperkind").Formula = 8
    vsoPage.PageSheet.Cells("PrintPageOrientation").Formula = 2
    
    LockTitleBlock

    Set AddSAPage = vsoPage
    
End Function