如何通过VBA代码批量为通过自选图形插入的图形添加题注？

tangqingfu

在文档中通过自选图形插入若干个图形（由多个图形组合而成的图形计为一个图形），请教如何通过VBA代码批量为这些图形添加题注(题注样式为“图1”、“图2”……），题注位于这些图形的正下方？

[ 本帖最后由 tangqingfu 于 2010-8-28 00:18 编辑 ]

守柔

原帖由 tangqingfu 于 2010-8-28 00:12 发表
在文档中通过自选图形插入若干个图形（由多个图形组合而成的图形计为一个图形），请教如何通过VBA代码批量为这些图形添加题注(题注样式为“图1”、“图2”……），题注位于这些图形的正下方？

请参考：
Sub Example()
    Dim oShape As Shape
    Dim tzShape As Shape
    For Each oShape In ActiveDocument.Shapes
        oShape.Select True
        Selection.InsertCaption Label:=图", TitleAutoText:="", Title:="", _
                                Position:=wdCaptionPositionBelow, ExcludeLabel:=0
        Set tzShape = Selection.ShapeRange(1)
        oShape.Select False
        Selection.ShapeRange.Group
    Next
End Sub

说明：确认Word 中存在“图”题注标签。

[ 本帖最后由 守柔 于 2010-8-30 05:16 编辑 ]

tangqingfu

To 守版：
复制代码至VBE中，发现
Selection.InsertCaption Label:="ͼ", TitleAutoText:="", Title:="", _
                                Position:=wdCaptionPositionBelow, ExcludeLabel:=0
中的ͼ不能正确显示，请教如何解决这一问题？如何才能正确输入？

守柔

原帖由 tangqingfu 于 2010-8-29 22:10 发表
To 守版：
复制代码至VBE中，发现
Selection.InsertCaption Label:="ͼ", TitleAutoText:="", Title:="", _
                                Position:=wdCaptionPositionBelow, ExcludeLabel:=0
...

这是VBE中中文输入法没有打开，导致复制时出现乱码了。不过我想汤兄可以想象一下就知道了，不就是“图”嘛。InsertCpation就是插入题注方法呀！

   Selection.InsertCaption Label:=图", TitleAutoText:="", Title:="", _
                                Position:=wdCaptionPositionBelow, ExcludeLabel:=0

tangqingfu

测试效果相当棒！谢谢守版！
不知如何添加代码，使批量添加的题注位于对应图形的正下方？

守柔

原帖由 tangqingfu 于 2010-8-30 16:54 发表
测试效果相当棒！谢谢守版！
不知如何添加代码，使批量添加的题注位于对应图形的正下方？

两件事：
一是二楼的代码是不是批量添加题注？添加的题注是不是对应图形的正下方？如果不是，又是在哪里？
二，上次你发的一个贴子，我误删了，请重发一下，就是“学科工具.dot”以及“密封线”的贴子。

tangqingfu

谢谢守版的一再关注！
二楼的帖子的确是批量添加题注，只是测试时发现：添加的题注（位于文本框内）不位于对应图形的正下方，即没有文本框居中对齐，添加了一句代码
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
能使文本框中的题注居中对齐。
再次请教守版：
1、如何将所有添加的题注所在的文本框置于底层？
2、如果文档中的图形已添加了题注，如何添加判断，使之做到对于已添加的题注的图形不再重复添加题注，并自动更新所有题注？
3、图形的对象是根据插入的先后顺序命名的，不知能否做到按图形所处的位置（从上到下、从左到右的原则）对添加的题注先后命名？即在同一行（段）中先对左边的图形添加题注，不同行（段）的，先对前一段的图形添加题注。这样，即使在插入题注后，在重新添加图片后，代码能将图形从上到下、从左到右的原则自动对其批量添加题注（而不是按图形插入的先后顺序对图形添加题注）

[ 本帖最后由 tangqingfu 于 2010-8-31 23:18 编辑 ]

tangqingfu

顶一下，能否再请守版帮忙？

zzpsx

请教完整可用的代码是什么？

dongdonggege

zzpsx 发表于 2022-1-3 10:33
请教完整可用的代码是什么？

1. Sub test()
   
2.     Set sld = ActiveDocument
   
3.     Set shp = sld.Shapes.AddShape(msoShapeRectangle, 220, 128, 112, 56)
   
4.     shp.Select
   
5.     Selection.InsertCaption Label:="图表", TitleAutoText:="InsertCaption", _
   
6.         Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
   
7.     Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
   
8. End Sub

复制代码

请测试