Кнопка создает новый лист из шаблона VBA - PullRequest
1 голос
/ 09 мая 2019

У меня есть этот код, который создает новый лист, и я могу выбрать идеальное имя.Но мне нужно было бы создать лист из "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

Ответы [ 2 ]

1 голос
/ 09 мая 2019
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 должен иметь только 1 лист.И всегда проверяйте успех, потому что эта операция иногда дает сбой.

0 голосов
/ 09 мая 2019

Приведенное ниже не проверено, и вам необходимо настроить пути к файлам и имена листов, чтобы они соответствовали тем, которые у вас есть на самом деле.Код должен открыть рабочую книгу с шаблоном, скопировать ее в свою книгу и затем закрыть шаблон.


    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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...