在工作表创建复制隐藏表“模板”

Question

使用 Excel 2013 宏，我希望能够在创建工作表时（“+”号或右键单击新工作表），而不是创建新工作表，而是复制隐藏的“模板”工作表来用作此工作簿的模板。最初将创建许多工作表，随着时间的推移，该工作簿将每天使用，同时可能还会打开其他工作簿。

我已经拥有的代码要求用户在创建时输入工作表的名称，并调用以字母数字顺序对当前工作簿的工作表进行排序并重建 TOC。有没有办法改变当前代码以匹配它的新目的？注意：此代码在 ThisWorkbook 中。

Private Sub Workbook_NewSheet(ByVal Sh As Object)

    Dim sName As String
    Dim bValidName As Boolean
    Dim i As Long

    bValidName = False

    Do While bValidName = False
        sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
            If Len(sName) > 0 Then
            For i = 1 To 7
                sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
            Next i
            sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
            If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
        End If
    Loop

    Sh.Name = sName

    Call Sort_Active_Book
    Call Rebuild_TOC

End Sub

编辑 1： 注意：“TEMPLATE”工作表只属于本工作簿，不需要在其他工作簿中使用，是本工作簿中的隐藏工作表。

Answer 1

更新的代码。 GSerg 说得对：

Private Sub Workbook_NewSheet(ByVal Sh As Object)

    Dim wb as Workbook
    Dim wsTemp as Worksheet
    Dim sName As String
    Dim bValidName As Boolean
    Dim i As Long

    bValidName = False

    Do While bValidName = False
        sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
            If Len(sName) > 0 Then
            For i = 1 To 7
                sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
            Next i
            sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
            If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
        End If
    Loop

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set wb = ThisWorkbook
    Set wsTemp = wb.Sheets("TEMPLATE")
    wsTemp.Visible = xlSheetVisible
    wsTemp.Copy After:=wb.Sheets(wb.Sheets.Count)
    ActiveSheet.Name = sName
    Sh.Delete
    wsTemp.Visible = xlSheetHidden   'Or xlSheetVeryHidden

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

    Call Sort_Active_Book
    Call Rebuild_TOC

End Sub

Answer 2

您的模板是否保存了一个可以为需要它的人提取的位置？如果没有，您只需要创建一个宏来格式化模板。

如果您已准备好模板，则只需要该文件的完整路径。我会关闭 application.screenupdating = false 并打开该文件，复制所需的工作表并将其粘贴到当前文档中，然后关闭模板文件和 application.screenupdating = true。

编辑：

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Template").Visible = True
sheets("Template").copy after:=Sheets(1)
Sheets("Template").Visible = False
ActiveSheet.Name = sName
Sheets(Sh.Name).Delete

Application.ScreenUpdating = True
Application.DisplayAlerts = True

这会起作用，您只需要更改模板路径