Хотите, чтобы шаблон WD был динамичным

Question

У меня есть следующий макрос, и я хочу, чтобы шаблон Wd (Template fisa de esantionare.dotm) сделал его динамичным, запускаемым разными пользователями.Спасибо

Modyfi этой строки кода: .Documents.Add "C: \ Users \ stefan.georgescu \ Desktop \ Template fisa de esantionare.dotm"

Sub ExportExcelDataToWordDocument()

    'Dim wdExcelApp As Application               'Excel is the default library (optional)
    Dim wdWordApp As Word.Application            'Word app
    Dim WB As Workbook
    Dim LastRow As Long

  Application.ScreenUpdating = False

' Creating a new instance of Word
    Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010


    With wdWordApp

        ' Making Word Visible on the screen
        .Visible = True             'iff false, document is invisible.

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' create a new Word Document based on the specified template
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        .Documents.Add "C:\Users\stefan.georgescu\Desktop\Template fisa de esantionare.dotm"

        'as before, copy the whole table from sheet to clipboard.
        Set WB = ThisWorkbook
        With WB.Sheets("GestiuneSSC")
        LastRow = .Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("A1", "F" & LastRow).Select
        Selection.Copy
        wdWordApp.Selection.GoTo what:=-1, Name:="bookmark1" ' -1 means "wdgotobookmark"
        wdWordApp.Selection.Paste      'paste from the clipboard to the Word Doc.

        End With

        '****************
                'as before, copy the whole table from sheet to clipboard.
        Sheets("AlimATM").Select
        Set WB = ThisWorkbook
        With WB.Sheets("AlimATM")
        LastRow = .Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("A1", "F" & LastRow).Select
        Selection.Copy
        wdWordApp.Selection.GoTo what:=-1, Name:="bookmark2" ' -1 means "wdgotobookmark"
        wdWordApp.Selection.Paste      'paste from the clipboard to the Word Doc.

        End With

  '****************
                'as before, copy the whole table from sheet to clipboard.
        Sheets("DepRidAngajati").Select
        Set WB = ThisWorkbook
        With WB.Sheets("DepRidAngajati")
        LastRow = .Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("A1", "F" & LastRow).Select
        Selection.Copy
        wdWordApp.Selection.GoTo what:=-1, Name:="bookmark3" ' -1 means "wdgotobookmark"
        wdWordApp.Selection.Paste      'paste from the clipboard to the Word Doc.

        End With

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Save WORD Document
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim TheFileName As String
        TheFileName = "C:\Users\stefan.georgescu\Desktop\Fisa de esantionare.docx"

        '......................................
        'Autofit tables in Wdoc
        Dim t As Table
        For Each t In ActiveDocument.Tables
        t.AutoFitBehavior wdAutoFitContent
        Next
        '.......................................

        '(SaveAs is for Office 2003 and earlier - deprecated)
        .ActiveDocument.SaveAs2 TheFileName
            'replaces existing .doc iff exists


        ' Close Documents and Quit Word
        .ActiveDocument.Close 'close .DOCx
        .Quit 'exit Word
    End With

  Application.ScreenUpdating = True

    'MEMORY CLEANUP
    Set wdWordApp = Nothing 'garbage collection
    'Set wdExcelApp = Nothing 'OPTIONAL


End Sub

Answer 1

Вы действительно должны поместить шаблоны в общее местоположение, к которому имеют доступ все пользователи, вместо того, чтобы помещать отдельные копии на рабочие столы пользователей.Тем не менее, вы можете использовать:

.Documents.Add "C:\Users\" & Environ("Username") & "\Desktop\Template fisa de esantionare.dotm"