导excel数据到word模板

一 Excel

step1:设定模板文件路径：可以放到.xlsm文件中。

step2:加入button后在button定义click事件中：加入宏

宏function：

Sub do_API()

    Dim data_sheet
    Dim i, j
    Dim find_str, repl_str
    Dim lq_string, rq_string
    
    Dim data_file, template_file, target_file
    Dim found
    
    data_file = ThisWorkbook.path & "\" & Sheet1.Cells(3, 2)
    template_file = ThisWorkbook.path & "\" & Sheet1.Cells(3, 3)
    
    lq_string = Left(Sheet1.Cells(1, 4), 1)
    rq_string = Right(Sheet1.Cells(1, 4), 1)
    
    
    Application.Workbooks.Open data_file
    
    
    found = False
    For i = 1 To ActiveWorkbook.Sheets.Count
        If InStr(ActiveWorkbook.Sheets(i).Name, "Datasource_SheetName") > 0 Then
            Set data_sheet = ActiveWorkbook.Sheets(i)
            found = True
            Exit For
        End If
    Next
    
    If Not found Then MsgBox "sheet not found!": Exit Sub
    
    Dim wdApp As New Word.Application
    wdApp.Visible = True
    
    
    For i = 2 To data_sheet.UsedRange.Rows.Count
        wdApp.Documents.Open template_file
        For j = 1 To data_sheet.UsedRange.Columns.Count
            

        
            find_str = lq_string & Replace(data_sheet.Cells(1, j), vbLf, "") & rq_string
            repl_str = data_sheet.Cells(i, j)
            Debug.Print "Replace " & find_str & " with " & repl_str
            
            If j =column_index1 Or j = column_index2 Then
                wdApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
                find_str = Replace(data_sheet.Cells(1, j), vbLf, "")
            Else
                wdApp.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
            End If
            
            
            wdApp.Selection.Find.ClearFormatting
            wdApp.Selection.Find.Replacement.ClearFormatting
            With wdApp.Selection.Find
                .Text = find_str
                .Replacement.Text = repl_str
                .Forward = True
                .Wrap = 1 'wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = False
                .MatchFuzzy = False
            End With
            wdApp.Selection.Find.Execute Replace:=2 'wdReplaceAll
            
            
        Next
        target_file = "SYM001 _" & data_sheet.Cells(i, index1) & "_" & data_sheet.Cells(i, index2) & ".doc"
        target_file = ThisWorkbook.path & "\" & target_file
        
        

        If Dir(target_file) <> "" Then Kill target_file
        wdApp.activedocument.SaveAs target_file
        wdApp.activedocument.Close False
        
    Next
    
    wdApp.Quit False
    Set wdApp = Nothing
    
    ActiveWorkbook.Close
    MsgBox "done!"
End Sub

二：　在word模板中加入相关的Mergefield可以了。