关于题注的一个问题，来者有分，不够可以再加

[eman1]

文档描述：
我要修改的文档大概有500页，图和表的题注都是在写这个文档的时候自动加上去的，大概有550张图和250张表。
当前：
图的题注当时选择了“图表”,编号使用了按标题（3级），举例：图表 1.4.1-1
表的题注当时选择了“表格”,编号使用了按标题（3级），举例: 表格 1.4.1-1
需要做的修改：
图的题注改为“图”，举例：图1-15
表的题注改为“表”，举例：表1-34
我最初采用的方法是：
1.新建题注的标签“图”和“表”
2.手动删除所有的图和表的题注，然后手动再用右键添加题注
后来使用了宏：
最初，觉得手动添加题注比较麻烦，就定义了一个自动添加题注的宏（并定义好快捷键），然后自己手动找到图或者表，然后使用这个宏的快捷键
后来，我还试验了编写宏，自动删除文档中所有的题注。这样是为了后面加入题注做好准备。
不过还是觉得需要手动查找表或者图，于是就又编写了一个宏，用于自动查找表格，然后插入题注。注意，这里没有自动查找图，是因为文章中有一些小图标不需要添加题注。
除了改题注，还要添加交叉引用，所以这些工作整整花了我两天的时间
我要问的问题：
能否有更好的方法实现题注的批量改变，比如说，给文档中所有的表格一次性自动加入题注，或者在已经有题注的情况下，统一更新题注的标签和编号方式。
希望大家能参与讨论此问题，来者有分，不够可加。

[eman1]

删除所有题注的宏代码如下，因为我的文档的图和表加起来不超过1000，所以定义了一个number，执行次数也不超过1000
Sub Macro1()
'
' 删除脚注 Macro
' 宏在 2004-5-5 由 lulu 录制
'
Dim number
number = 1
label1:
If number < 1000 Then GoTo label2 Else GoTo lastline
label2:
Selection.GoTo What:=wdGoToField, Which:=wdGoToNext, Count:=1, Name:= _
"STYLEREF"
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
number = number + 1
Selection.HomeKey unit:=wdLine
Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.EndKey unit:=wdLine, Extend:=wdExtend
If InStr(Selection.Text, "图") Or InStr(Selection.Text, "表") Then GoTo delete Else GoTo label1
delete:
Selection.delete unit:=wdCharacter, Count:=1
If number < 1000 Then GoTo label2 Else GoTo lastline
End With
lastline:
Dim test
End Sub

[eman1]

呵呵，看来只有自问自答了，刚才研究了一种自动更新题注编号的方法:
1.在题注编号的位置上使用快捷键shift＋F9，或者鼠标右键，再谈出的菜单上点击切换域代码
2.可以看到图表 1.4.1-1这种格式的域代码为：图表｛STYLEREF 3 \s｝-{SEQ 图表 \* ARABIC \s 3}
3.使用Ctrl+H打开替换对话框，将上述域代码替换为：图｛STYLEREF 1 \s｝-{SEQ 图 \* ARABIC \s 1}，选择全部替换
4.在此使用快捷键shift＋F9，然后全选Ctrl+A，使用快捷键F9更新域，这样就可以是题注编码变为图1-15这种格式了，如果文章中有对图的题注的交叉引用，也可以自动更新为图1-15这种编号方式

[eman1]

同理，对于表的题注的更新也可以采用这种方式

[buddy_wu]

嗯，对的，不错啊。不过我认为还可以改进一下嘛，就是在事先没有给过题注的情况下也可以自动增加题注

[eman1]

刚才上面的那个回答有点问题：
不能直接替换图表｛STYLEREF 3 \s｝-{SEQ 图表 \* ARABIC \s 3}，必须分别替换“STYLEREF 3 \s”和“SEQ 图表 \* ARABIC \s 3”，否则一旦加上“｛”或者“}”域代码在替换对话框中就会自动转化为相应的编号数字，就无法顺利完成替换了
所以，刚才的方法还有一个不足之处，“图表 1.4.1-1”这种格式只能转化为“图表1-15”这种格式，而无法转化为“图1-15”这种格式。“表格 1.4.1-1”也只能转化为“表格 1-15”的格式。
可能有人会想用“图”全部替换“图表”，但我们无法肯定正文里面没有“图表”字样，因此，也就必须一个一个替换，这样也很麻烦…………
希望有更好的解决方法，期待ing………

[smartpigeon]

up

[rnjan2000]

S s ...

[code菜鸟newbee]

又学习了

[yinghuajie]

关注中

[yigepure]

哈哈，不错，水平很高嘛。

[duanshengyong]

楼主vba用得不错么,如果是我的话,就只好用菜单里的查找替换了,

[贝壳鱼]

good job!

[lishentothenmuic]

怎么office也可以编代码的吗？

[eman1]

再给大家一段脚本,是buddy_wu(buddy)给我的，可以自动查找文档中的所有图片，然后插入脚注，不过有个问题，不是技术问题：
如果文档中有些小图标，不想插入脚注也不行，呵呵，该脚本会自动给所有图片插入脚本，可以用于已经插入图片，但是没有脚注的文档使用
Sub Macro3()
'
' Macro3 Macro
' 宏在 2004-5-5
'
Selection.GoTo What:=wdGoToGraphic, Which:=wdGoToNext, Count:=1, Name:=""
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
'Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
'Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InsertCaption Label:="图", TitleAutoText:="InsertCaption2", Title _
:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub

[eman1]

其实我不会写vba
不过因为有时候编写word工作量很大
就录制一些相关的宏修改修改，还是比较有用的
word里面有很多高级功能，大家多研究研究，相互交流，提高工作效率

[shadow22]

up

[ROBOT]

wonderful artical

[yinliang66]

又学习了

[icuc88]

不是人人都回VBA的，学习：）

[xiaominli27]

学习一下。