好吧，我要在右页脚中放置Excel报告的页码。
为此，我使用VBA宏生成页面，并将信息从“页眉详细信息”表复制到模板表的副本，然后将其用作报告的实际页面。
问题是简介页的初始值与预期的一样，但是转到下一页时，它随机增加8，因此变成“ x的第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
答案 0 :(得分：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）取消保护。