Question

我创建了一个宏模板（workbook.xltm）并将其移至C:\Users\USER\AppData\Roaming\Microsoft\Excel\XLSTART。因此，此文件将作为默认工作簿打开。当用户单击“保存”按钮时，工作簿包含一个执行的小脚本。该脚本将页眉和页脚添加到所有工作表中。

我的问题是工作流程，因为当打开一个新文件时，用户倾向于通过更改公司名称来更改标题。不幸的是，此时文件尚未保存，因此通过单击保存按钮，标题将被脚本中的默认公司名称覆盖。

最好有一个条件来检查页眉和页脚是否已存在。这就是用户第一次保存文件的时间。这样可以避免用脚本的默认标题文本覆盖标题的情况。
此外，如果将第一张纸的页眉和页脚（从左至右）用于（复制到）所有新创建的纸页（如果用户创建了它们），那将是很好的。现在，如果用户创建一个新工作表并单击“保存”按钮，则新工作表中的页眉/页脚看起来就像脚本中的默认页眉/页脚。

脚本：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveSheet.PageSetup.LeftHeader = "Company: Company Ltd." & Chr(10) & "Cutoff date: 31.12.20XX"
    ActiveSheet.PageSetup.LeftFooter = "Filename: &F" & Chr(10) & "Sheet: &A"
    ActiveSheet.PageSetup.CenterFooter = "Page &P of &N"
    ActiveSheet.PageSetup.TopMargin = Application.CentimetersToPoints(3.91)
    ActiveSheet.PageSetup.HeaderMargin = Application.CentimetersToPoints(1.91)
End Sub

Answer 1

我会将默认模板的左，中和右标题保留为空，并在保存时进行检查。然后，我将保存这些值并将其复制到所有其他工作表中。如果您有很多纸张，则值得暂时关闭打印通信。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ShActive as Worksheet, sh As Worksheet
    Dim sLH as String, sCH as String, sRH As String

    Application.Printcommunication = False
    Set shActive = ActiveSheet
    With Activesheet.PageSetup
         sLH = .LeftHeader
         sCH = .CenterHeader
         ...
         If lenb(sLH) = 0 And lenb(sCH) = 0 And lenb(sRH) = 0 Then ' all empty = set defaults
              sLH = "Company: Company Ltd." & Chr(10) & "Cutoff date: 31.12.20XX"
              ....
         End If
    End With

    For Each sh in ActiveWorkBook.Sheets
        With sh.PageSetup
            .LeftHeader = sLH
            ...
        End With
    Next
    shActive.Activate ' just for sure
    Application.Printcommunication = True

Answer 2

感谢您的投入和支持。我设法用名为“ Template”的工作表创建了一个模板文件，该文件已经具有几乎所有用户创建的所有工作表所需要的信息。现在，我需要重新添加Workbook_BeforeSave事件，因为当前脚本无法处理用户将工作表从另一个工作簿复制到该工作表的事件。因此，复制的工作表缺少页眉和页脚。

当前脚本将页眉和页脚添加到所有新创建的工作表中：
它将表“模板”的信息复制到新创建的表中。因此，“模板”表是必需的。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.ScreenUpdating = False
    With Sheets("Template").PageSetup
        strHeadLeft = .LeftHeader
        strHeadCenter = .CenterHeader
        strHeadRight = .RightHeader
        'strFootLeft = .LeftFooter
        'strFootCenter = .CenterFooter
        'strFootRight = .RightFooter
        bGotHeaders = True
    End With
    If bGotHeaders Then
        With ActiveSheet.PageSetup
            .LeftHeader = strHeadLeft
            .CenterHeader = strHeadCenter

            If IsEmpty(strHeadRight) Then
                strHeadRight = _
                 "&10Ref: &B&10&KFF0000 XXX-XXX" & _
                  Chr(10) & _
                  "&B&K000000File date created: " & _
                  Format(Date, "dd.mm.yyyy") & " " & Time & Chr(10) & _
                  "User: &B" & Application.UserName
            Else
                strHeadRight = strHeadRight & _
                 Chr(10) & _
                 "&B&K000000File date created: " & _
                 Format(Date, "dd.mm.yyyy") & " " & Time & Chr(10) & _
                 "User: &B" & Application.UserName
            End If

            .RightHeader = strHeadRight
            .LeftFooter = "&10Filename: &F" & Chr(10) & "Sheet: &A"
            '.CenterFooter = strFootCenter
            .RightFooter = _
              "&10Page &P of &N"
        End With
    Else
        MsgBox "Sheet Template does not exist." & vbCrLf & _
        "For this reason, the header and footer cannot be inserted into newly created spreadsheets.", _
        vbExclamation, "No Headers In Memory"
    End If
    Application.ScreenUpdating = True
End Sub

在保存事件上创建页眉和页脚。检查页眉或页脚是否存在

2 个答案: