准备工作:

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

SRE实战 互联网时代守护先锋,助力企业售后服务体系运筹帷幄!一键直达领取阿里云限量特价优惠。

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

 

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

 

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

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

 

插入代码如下:

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

扫码关注我们
微信号:SRE实战
拒绝背锅 运筹帷幄