使用VBA将Excel指定单元格数据字符串或者图表对象插入到Word模板指定书签处

Posted 2021-11-27 ty1216jhy

准备工作：

1、首先需要提供一个word模板，并且标记好您要插入书签的位置，定义书签的命名。如图

 

 

2、模拟您要插入的Excel原始数据和图表对象

 

插入代码如下：

Private Sub CommandButton1_Click()
    
    Dim App, WrdDoc, Mypath As String
    
    On Error Resume Next
    ‘定义原始模板的储存路径，默认和excel在同一路径
    Mypath = ThisWorkbook.Path & "\\模板.doc"
    ‘用Set关键字创建Word应用成序对象！
    Set App = CreateObject("Word.Application")
    App.Visible = True
    ‘打开这个Word文件！
    Set WrdDoc = App.Documents.Open(Mypath)
    ‘以当前模板创建一个新的模板
    Set word = App.Documents.Add(Mypath)
    ‘将excel指定单元格的数据写入之前已经编辑定位好的word书签位置
    word.Bookmarks("书签1").Range = Range("b2")
    word.Bookmarks("书签2").Range = Range("b3")
    word.Bookmarks("书签3").Range = Range("b4")
    word.Bookmarks("书签4").Range = Range("b5")
    word.Bookmarks("书签5").Range = Range("b6")
    
    ‘‘插入当前工作表的2个图表对象到指定位置，并显示出来
    ‘‘更改word 插入对象的环绕方式
    ‘‘http://www.debugease.com/vb/2205943.html
    With App
        ThisWorkbook.Worksheets("底稿数据").ChartObjects(1).Activate
        ActiveChart.ChartArea.Copy
        .ActiveDocument.Bookmarks("收入情况图").Range.Select
        .Selection.Paste
        .ActiveDocument.InlineShapes.Item(1).ConvertToShape
        .ActiveDocument.Shapes.Item(1).WrapFormat.Type = wdWrapTight
        
        ThisWorkbook.Worksheets("底稿数据").ChartObjects(2).Activate
        ActiveChart.ChartArea.Copy
        .ActiveDocument.Bookmarks("支出情况图").Range.Select
        .Selection.Paste
        .ActiveDocument.InlineShapes.Item(1).ConvertToShape
        .ActiveDocument.Shapes.Item(1).WrapFormat.Type = wdWrapTight ‘更改环绕方式
    End With
    
    Paths = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\\" ‘记录“桌面”文件夹的路径
    word.SaveAs Filename:=Paths & "2019年X月XXXX食堂收支分析报告" & ".doc" ‘另存为word报告成品
    word.Close ‘ 关闭文件
    App.Quit
    Set App = Nothing
    MsgBox "2019年X月XXXX食堂收支分析报告", vbInformation, "报告已生成到桌面"
    Shell "EXPLORER.EXE " & Left(Paths, Len(Paths) - 1), vbMaximizedFocus ‘打开桌面
End Sub

 

附件下载地址：

https://files.cnblogs.com/files/ty1216jhy/%E8%87%AA%E5%8A%A8%E7%94%9F%E6%88%90%E9%A3%9F%E5%A0%82%E6%8A%A5%E5%91%8A.rar

联系QQ：609682901