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

tangqingfu · 发表于 2010-8-28 00:12

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

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

守柔 · 发表于 2010-8-29 09:23

原帖由 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 · 发表于 2010-8-29 22:10

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

守柔 · 发表于 2010-8-30 05:18

原帖由 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 · 发表于 2010-8-30 16:54

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

守柔 · 发表于 2010-8-30 17:15

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

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

tangqingfu · 发表于 2010-8-31 17:07

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

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

tangqingfu · 发表于 2010-9-2 00:24

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

zzpsx · 发表于 2022-1-3 10:33

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

dongdonggege · 发表于 2023-4-6 15:04

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

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

复制代码

请测试

		自动登录	找回密码
密码			免费注册

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

浏览过的版块