Как я могу остановить мой генератор страниц от случайного увеличения?

Question

Хорошо, я хочу поместить в правом нижнем колонтитуле номер страницы для отчета Excel.

Для этого я использую макрос VBA для генерации страниц, и информация копируется из из листа сведений заголовка к копии листа шаблона, которая затем используется в качестве фактической страницы для отчета.

Проблема в том, что вводная страница печатается с исходным значением, как и ожидалось, но при переходе на следующую страницу она случайным образом увеличивается на 8, так что становится «страница 9 из х». Как я могу остановить его от этого случайного прыжка?

Страницы отчета

Sub ReportPages()

Dim areas As Integer
Dim pageNumberTotal As Integer
areas = 1
' Unhides the Template sheet so it is ready to be used.
Worksheets("Template").Visible = True

' Add new pages based on the header details sheet.
Sheets("Header Details").Select

' Select cell A14 as the basis to fill out the template with data.
Range("A14").Select

Do While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Select
    areas = areas + 1
Loop

pageNumberTotal = areas + 5

' Matches the amount of areas tested that have been specified in the Header Details sheet
Do While areas > 1
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = areas - 1 Then
        exists = True
        End If
    Next i
    If exists = True Then
        areas = areas - 1
        exists = False
    Else
        ' Decrement by 1 and copy the relevant data to the template.
        areas = areas - 1
        Sheets("Template").Select
        Sheets("Template").Copy After:=Worksheets("Template")
        Sheets("Template (2)").Select
        Sheets("Template (2)").Name = areas
        Range("I6").Select
        ActiveCell = areas
        ' Call the WetDry function and then protect the sheet.
        Call WetDry

    End If
Loop

' Closes the template sheet when it is done.
Worksheets("Template").Visible = False

'If ActiveSheet.Name = 1 Then
    'Dim pageNumberSetting As String
    'Dim pageNumber As Integer
    'pageNumber = 1
    'Sheets("Front Page").Select
    ' Sets the font type and size of the page number and page total in the bottom right hand corner of the page.
    'pageNumberSetting = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
    'With ActiveSheet.PageSetup
        '.RightFooter = pageNumberSetting
    'End With


    'pageNumber = pageNumber + 1
    'ActiveSheet.Next.Activate 
'End If
    ' Calls the next function and passes the value of the page number setting.
    Call FrontBackPages       
 End Sub

Передняя и задняя страницы

Sub FrontBackPages()

' Sets the preliminary features for the start of the report.
' Declarations of variables.
If ActiveSheet.Name = 1 Then
    Dim pageNumberSetting As String
    Dim pageNumber As Integer
    pageNumber = 1
    Sheets("Front Page").Select

    ' Debug message - please ignore.
    ' MsgBox " The Name of the active sheet is " & ActiveSheet.Name


    ' Sets the font type and size of the page number and page total in the bottom right hand corner of the page.
    pageNumberSetting = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
    With ActiveSheet.PageSetup
        .RightFooter = pageNumberSetting

    End With

    pageNumber = pageNumber + 1
    ActiveSheet.Next.Activate

    ' Selects the "Appx Summary" sheet and propegates it with information from other parts of the workbook,
    ' generates a page number for this part of the report.
    Do While ActiveSheet.Name <> "Appx Summary"
        pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."

        ' If the active sheet condition is met then the "Slip Resistance Testing" sheet is selected and is
        ' given a page number that will be placed in the lower right hand corner of the page.
        If ActiveSheet.Name = "Slip Resistance Testing" Then
            With ActiveSheet.PageSetup
                .FirstPage.RightFooter.Text = pageNumberParameter
            End With
            pageNumber = pageNumber + 1
            pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
        End If

        ' The "Template" sheet is selected and the page number is decremented by 1.
        If ActiveSheet.Name = "Template" Then
            pageNumber = pageNumber - 1
        End If

        ' The active sheet is selected and in the right - hand footer is given a page number.
        ' After this the next sheet is activated.
        With ActiveSheet.PageSetup
            .RightFooter = pageNumberParameter
        End With
        pageNumber = pageNumber + 1
        ActiveSheet.Next.Activate
    Loop

    ' The page number is then added to the page and also gives the total page number as well.
    ' This will place the page number in the bottom right hand corner of the page..
        pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
    With ActiveSheet.PageSetup
        .FirstPage.RightFooter.Text = pageNumberParameter
    End With
End If
' Selectes the "Header Details" sheet and the prompts the user that the pages have been successfully added.
Sheets("Header Details").Select
MsgBox "Pages Added!"

End Sub

Answer 1

Я значительно сократил объем кода. Я также вырезал тяжелый ресурс .activate / .select. Я много комментировал, поэтому не нужно много объяснений, но я скажу, что если вам нужны разъяснения, не стесняйтесь отвечать на этот ответ.

---

Известные люди

• Я не знаю, что делает звонок на WetDry, поэтому я добавил его там, где, как я полагаю, должен был быть.

---

Код

    Sub ReportPages()
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Dim wb As Workbook: Set wb = ThisWorkbook
        Dim srcws As Worksheet: Set srcws = wb.Worksheets("Header Details")
        Dim destws As Worksheet: Set destws = wb.Worksheets("Template")
        Dim pageNumber, pageNumberTotal As Integer
        Dim lRow, I As Long
        Dim Sht As Worksheet
        Dim ShtProtect as Integer
        Dim Shtpw as String

        Shtpw = "worksheet password"

        ' Unhides the Template sheet so it is ready to be used.
          destws.Visible = True

        ' Finds last row in Header Details
        lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row

        On Error Resume Next
        ' creates new tab (naming it was just an unneeded extra step) and populates I6
        For I = 14 To lRow
            If IsEmpty(srcws.Cells(I, 1).Value) Then Exit For
            For Each Sht In wb.Worksheets
                If Application.Proper(Sht.Name) = Application.Proper(srcws.Cells(I, 1).Value) Then
                    ' check to see if the worksheet is protected
                    If Sht.ProtectContents = True Then
                        ' remove sheet protection
                        Sht.Unprotect Shtpw
                        Shtprotect = 1
                    End If
                    destws.Copy After:=destws
                    srcws.Cells(I, 1).Copy
                    destws.Range("I6").PasteSpecial (xlPasteValues)
                    ' Call the WetDry function and then protect the sheet.
                    Call WetDry
                    ' reapply protection
                    If Shtprotect = 1 then
                       Sht.Protect Shtpw
                       Shtprotect = 0
                    End If
                End If
            Next Sht
        Next I

        ' Establishes total pages
        For I = 1 To wb.Sheets.Count
            If InStr(1, wb.Worksheets(I).Name, "Template (") > 0 Then pageNumberTotal = pageNumberTotal + 1
        Next

        ' populates footer
        For I = 1 To wb.Sheets.Count
            If InStr(1, wb.Worksheets(I).Name, "Template (") > 0 Then
                pageNumber = pageNumber + 1
                wb.Worksheets("Template (" & pageNumber + 1 & ")").PageSetup.RightFooter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
            End If
        Next
        wb.Worksheets("Front Page").PageSetup.RightFooter = "&B&9Page 1 of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
        wb.Worksheets("Slip Resistance Testing").PageSetup.FirstPage.RightFooter.Text = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
        ' Hides the template sheet when it is done.
        destws.Visible = False

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        wb.Worksheets("Header Details").Activate
        MsgBox "Pages Added!"
    End Sub

---

РЕДАКТИРОВАТЬ

• Добавлено Shtpw в качестве единой ссылки для нескольких вызовов в коде.
  • Предполагается, что один и тот же пароль используется на каждом защищенном листе.
• Добавлены проверки, чтобы увидеть, был ли рабочий лист защищен в первую очередь. Если это так, он снимает защиту с использованием заданного пароля (Shtpw).
• Добавлена ​​вторая проверка, чтобы увидеть, был ли изначально пароль, и повторное применение по мере необходимости.