利用excel生成word并在其中批量插入图片和题注、文字描述等内容

您所在的位置:网站首页 如何在表格中添加题注 利用excel生成word并在其中批量插入图片和题注、文字描述等内容

利用excel生成word并在其中批量插入图片和题注、文字描述等内容

2023-12-10 19:12| 来源: 网络整理| 查看: 265

对于word中需要插入大量类型相似的图片,使用excel插入图片、题注、文字描述等内容是非常方便的,先使用excel编辑好各个图片对应的题注、描述内容,通过excel也可以很快的调整这些内容,比如统一修改题注、调整顺序,排序等操作。统一批量生成于word中后,再复制粘贴到所需文档的对应地方就可以了。

过程:遍历每个工作表(sheet),根据工作表的名字生成一级标题,然后再遍历当前工作表中已配置好的内容,先插入图片,在图片下面插入题注,换行再插入文字描述(可以插入大段的内容,也可为空)。可在多个工作表中设置下面内容,便于分类处理。

excel中工作表第一列为图片的题注(可根据图片名字批量处理得来),第二列为图片路径(遍历每个文件下的路径自行百度),第三列为图片的描述内容。

需要说明的是,题注的格式需要预先使用word编辑好(比如题注的名字为“图”,VBA引用中也要为“图”)。word的一级标题格式名字、生成word的路径需要根据实际情况修改。

下面是excel中的格式,直接在上面添加宏命令然后执行就行了。

下面是代码

Sub 生成word() Dim wordApp As Word.Application Application.StatusBar = "正在创建。。。" Set wordApp = New Word.Application With wordApp .Visible = False Application.StatusBar = "正在创建word" .Documents.Add For Each sh In ActiveWorkbook.Sheets If sh.Name "文件信息清单" Then '此处可根据需要自行设置或者删除改语句 .Selection.TypeText Text:=sh.Name '此处"标题 1"为一级标题格式,可根据自己的word实际情况进行修改 .Selection.Style = .ActiveDocument.Styles("标题 1") .Selection.TypeParagraph For r = 2 To sh.UsedRange.Rows.Count figtitle = sh.Cells(r, 1).Value figpath = sh.Cells(r, 2).Value remark = sh.Cells(r, 3).Value '根据路径插入图片 .Selection.InlineShapes.AddPicture Filename:=figpath, LinkToFile:=False, SaveWithDocument:=True .Selection.MoveLeft '.Selection.ParagraphFormat.IndentFirstLineCharWidth 0 .Selection.MoveDown unit:=wdParagraph, Extend:=wdExtend '插入题注 .Selection.InsertCaption Label:="图", TitleAutoText:="", Title:=figtitle, Position:=wdCaptionPositionAbove, ExcludeLabel:=False '插入题注 ' .LockAspectRatio = msoFalse '取消图片大小纵横比的锁定 ' ' .Height = 285 '设置图片高度为 400px ' .Width = 374 '设置图片宽度 300px ' .Selection.Range.Previous(unit:=wdParagraph).Font.Name = "宋体" '更改字体 .Selection.Range.Previous(unit:=wdParagraph).Font.Size = 12 '更改字号 .Selection.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter '.Selection.TypeParagraph .Selection.EndKey unit:=wdStory .Selection.TypeParagraph '插入文字描述 If remark "" Then .Selection.TypeText Text:=remark .Selection.Style = .ActiveDocument.Styles("正文") '.Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2 End If Next End If Next '.ActiveDocument.Paragraphs(1).Range.InsertBefore ("邀请函") Application.StatusBar = "正在保存" '生成word的保存路径,可根据实际情况修改 .ActiveDocument.SaveAs2 ("E:\地名数据处理\文档\题注图片.docx") Application.StatusBar = "正在退出" .Quit End With Set wordApp = Nothing Application.StatusBar = False End Sub

 



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3