一个EXCEL数据导出到WORD的公告案例，导出到word公告

先上效果图

 

公告要解决的问题

1、工作日的自动计算问题,参考这篇文章；

工作日解决方案，求解过程，附件是2019-2021工作日清单_countsun的博客-CSDN博客

 2、如果有表格，替换和自动增加问题

VBA的源码

Private Sub CommandButton1_Click()

Dim wordobj As New Word.Application, ii, jj, cl, arr
tt = Timer
   selfpath = ThisWorkbook.Path
   tempPath = ThisWorkbook.Path
  strSheet1 = "信息表"
  strSheet2 = "数据属性"
  savepath = Sheets(strSheet2).Cells(7, 3)
  If Sheets(strSheet2).Cells(2, 3) <> "" Then
    wordtemplet = Sheets(strSheet2).Cells(2, 3)
    kuozhuan = Split(wordtemplet, ".")(UBound(Split(wordtemplet, ".")))
    Else
    MsgBox "没有模板"
    End
  End If
  
beginline = Int(Sheets(strSheet2).Cells(4, 3))
lastline = Int(Sheets(strSheet2).Cells(5, 3))
endcl = Int(Sheets(strSheet2).Cells(6, 3))
   判断 = 0
  t = ThisWorkbook.Path
   Set Fso = CreateObject("scripting.filesystemobject")
    If (Fso.Folderexists(t & "\" & savepath)) Then
       '如果存在不管他
       ' MsgBox "拆分操作没有完成!" & vbCrLf & "请到本目录下“拆分后文档”文件夹查看！！", vbInformation
       ' Exit Sub
     Else
       Set f1 = Fso.CreateFolder(t & "\" & savepath)
     End If
  '以上创建文件夹，多谢Mn860429卡卡西
savepath = ThisWorkbook.Path & "\" & savepath

  For i = beginline To lastline
   t1 = Timer

     If Sheets(strSheet1).Cells(i, 12) <> "" And Sheets(strSheet1).Cells(i, 12) <> 0 Then
      outpath_name = savepath & "\" & Sheets(strSheet1).Cells(i, 12) & "." & kuozhuan
      FileCopy selfpath & "\" & wordtemplet & "", outpath_name
       Debug.Print Str(Timer - t1) + "复制打开dao"
         With wordobj
        .Documents.Open outpath_name
        .Visible = False
        End With
        Debug.Print Str(Timer - t1) + "复制打开dao"
     t2 = Timer
       For j = 3 To endcl '填写文字数据 还不知怎么判断
          str1 = ThisWorkbook.Sheets(strSheet1).Cells(2, j)
          If Application.IsNA(ThisWorkbook.Sheets(strSheet1).Cells(i, j)) Then
          Str2 = ""
          Else
          Str2 = ThisWorkbook.Sheets(strSheet1).Cells(i, j)
          End If
  '   wb.Worksheets(1).UsedRange.Cells.Replace str1, Str2

       wordobj.Selection.Find.ClearFormatting
       wordobj.Selection.Find.Replacement.ClearFormatting
       With wordobj.Selection.Find
                .Text = str1
                .Replacement.Text = Str2
                 .Replacement.Font.Color = wdColorAutomatic
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
       End With
       wordobj.Selection.Find.Execute Replace:=wdReplaceAll

   Next
     Debug.Print Str(Timer - t2) + "替换"
     Debug.Print Str(Timer - t1) + "替换dao"
     t3 = Timer
         cl = Sheets(strSheet1).Cells(i, 18) - 1
       arr = Sheets(strSheet1).Cells(i, 4).Resize(i + cl, 9)
       
    Dim oDoc As Document
    Set oDoc = wordobj.ActiveDocument
    Dim oT As Table
    Dim oRow As Row
    Dim oColumn As Column
       
      If cl + 1 > 1 Then
      
        With oDoc
            Set oT = .Tables(1)
            With oT
                '设置要在第几行前面插入行，这里是第2行
                For ci = 1 To cl
                Set oRow = .Rows(2)
                '在第2行前面插入行
                .Rows.Add oRow
                Next ci
            End With
      End With
      
      End If
    
     
       For jj = 2 To 2 + cl '格数据
     
        wordobj.ActiveDocument.Tables(1).Cell(jj, 1).Range = jj - 1
                      For ii = 2 To 7
        wordobj.ActiveDocument.Tables(1).Cell(jj, ii).Range = arr(jj - 1, ii - 1)
              
         Next ii
         Next jj
         
   
   
   
  
         
      wordobj.Documents.Save
     Debug.Print Str(Timer - t3) + "save"
'      If isshow Then
'      wordobj.Visible = True
'      Exit Function
'      Else

      wordobj.Quit
       
      Set wordobj = Nothing
   
   End If
          
  Debug.Print Str(Timer - t1)
Next

   '  MsgBox Timer - tt
End Sub

具体的实现过程和案例文档

EXCEL批量生成WORD公告，EXCEL导出到word案例-数据集文档类资源-CSDN下载

实现的思路，查看下面这个文章，其实就是替换。

Excel批量产生excel或者word （单行或多行、多个sheet数据导入到一个word或者一个excel）_countsun的博客-CSDN博客_excel数据批量导入word模板