Question

我有这段代码正在创建新工作表，我可以选择一个完美的名称。但我需要它来从“ TEMPLATE.xltx”创建工作表。

我不知道该怎么做，正在测试不同的东西，但我无法使其正常工作。这里有人可以帮助我解决这个问题吗？

Sub addWS()
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet

Do
    On Error Resume Next

    SheetName = InputBox("Skriv in namnet på den nya fliken" & vbNewLine & _
    "Inkludera inte dessa tecken !!" & vbNewLine & _
    "* [ \ / ' : ? [ ]", "Skapa ny flik")

    If SheetName = "" Then Exit Sub
    'Create New Sheet at the end
     Sheets.Add after:=Sheets(Sheets.count)
    ActiveSheet.Name = SheetName



    If Err.Number = 0 Then
        Set ANewSheet = ActiveSheet
        Exit Do
    End If

    MsgBox SheetName & " innehåller tecken som inte är okej." & vbNewLine & _
    "eller redan existerar!", vbCritical, "Check your Sheet Name"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
Loop
On Error GoTo 0
Call sourceSheet.Activate
End Sub

Answer 1

Dim wb as WorkBook
Dim shNew as WorkSheet
Set wb = Activeworkbook
sTemplateFile = "C:\Template.xltx"

Set shNew = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count), Type:=sTemplateFile)

sTemplateFile应该只有一张纸。并始终检查成功，因为此操作有时会失败。

Answer 2

以下内容未经测试，您需要调整文件路径和工作表名称以匹配您实际拥有的文件路径和工作表名称。代码应该执行的操作是打开包含模板表的工作簿，将其复制到您的书中，然后关闭模板。


    Sub addWS()
    Dim sourceSheet As Worksheet
    Set sourceSheet = ActiveSheet

    Set wbActive = ThisWorkbook

    TemplatePath = "C:\Template.xltx"
    set wbTemplate =  Application.Workbooks.Open(TemplatePath)
    set shtTemplate = wbTemplate.Sheets("TEMPLATE") 

    Do
        On Error Resume Next

        SheetName = InputBox("Skriv in namnet på den nya fliken" & vbNewLine & _
        "Inkludera inte dessa tecken !!" & vbNewLine & _
        "* [ \ / ' : ? [ ]", "Skapa ny flik")

        If SheetName = "" Then Exit Sub
        'Create New Sheet at the end
        wbTemplate.Worksheets(shtTemplate).Copy _     
        After:=wbActive.Sheets(wbActive.Sheets.count)
        wbActive.Sheets(wbActive.Sheets.count).Activate
        ActiveSheet.Name = SheetName

       wbTemplate.Close  false
       set wbTemplate = Nothing
       set shtTemplate = Nothing


        If Err.Number = 0 Then
            Set ANewSheet = ActiveSheet
            Exit Do
        End If

        MsgBox SheetName & " innehåller tecken som inte är okej." & vbNewLine & _
        "eller redan existerar!", vbCritical, "Check your Sheet Name"
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    Loop
    On Error GoTo 0
    Call sourceSheet.Activate
    End Sub

按钮从模板VBA创建新工作表

2 个答案: