一个项目文档，如果没有题注会显得格外不专业，几百页的文档手动添加又会变得非常麻烦，可以通过vba脚本来快速实现。

SubBatchAddChapterCaption()DimimgAsInlineShapeDimrngAsRangeDimchapNumAsStringDimpicIdxAsLong' 字典：记录每个章节下图片序号DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")Application.ScreenUpdating=FalsepicIdx=0For EachimgInActiveDocument.InlineShapesIfimg.Type=wdInlineShapePictureThenpicIdx=picIdx+1Setrng=img.Range'===== 关键：获取图片所在章节自动编号 =====chapNum=GetCurrentChapterNumber(rng)IfchapNum=""ThenchapNum="0.0.0"'===== 统计当前章节内第几张图 =====Ifdict.Exists(chapNum)Thendict(chapNum)=dict(chapNum)+1Elsedict(chapNum)=1EndIf'===== 拼接题注，可自定义后缀文字 =====DimcapTextAsString' 格式：图 2.3.1-2 自定义文字' capText = "图 " & chapNum & "-" & dict(chapNum) & " 列表查询-1"capText="图 "&chapNum&"-"&dict(chapNum)'===== 在图片下方新建段落插入题注 =====rng.Collapse Direction:=wdCollapseEnd rng.InsertParagraphAfter rng.Move Unit:=wdParagraph rng.Text=capText'===== 你原有格式：宋体、小五、居中 =====Withrng.Font .Name="宋体".Size=9EndWithrng.ParagraphFormat.Alignment=wdAlignParagraphCenter' 段前/段后小幅间距，符合论文规范rng.ParagraphFormat.SpaceBefore=3rng.ParagraphFormat.SpaceAfter=3EndIfNextimg Application.ScreenUpdating=TrueMsgBox"完成！共生成 "&picIdx&" 张章节式题注",vbInformationEndSub'【自定义函数】获取 章节编号 + 标题文字（如：2.3.1列表查询）PrivateFunctionGetCurrentChapterNumber(ByValrngAsRange)AsStringDimparaAsParagraphSetpara=rng.Paragraphs(1)' 向上查找最近的 带自动编号的标题DoWhileNotparaIsNothingIfpara.Range.ListFormat.ListType=wdListOutlineNumberingThen' 获取：编号 + 标题文字（无空格）GetCurrentChapterNumber=Replace(para.Range.ListFormat.ListString&para.Range.Text,Chr(13),"")ExitFunctionEndIfSetpara=para.PreviousLoopGetCurrentChapterNumber="无章节"EndFunction