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

eman1 2004-05-05 03:19:29
文档描述:
我要修改的文档大概有500页,图和表的题注都是在写这个文档的时候自动加上去的,大概有550张图和250张表。
当前:
图的题注当时选择了“图表”,编号使用了按标题(3级),举例:图表 1.4.1-1
表的题注当时选择了“表格”,编号使用了按标题(3级),举例: 表格 1.4.1-1
需要做的修改:
图的题注改为“图”,举例:图1-15
表的题注改为“表”,举例:表1-34
我最初采用的方法是:
1.新建题注的标签“图”和“表”
2.手动删除所有的图和表的题注,然后手动再用右键添加题注
后来使用了宏:
最初,觉得手动添加题注比较麻烦,就定义了一个自动添加题注的宏(并定义好快捷键),然后自己手动找到图或者表,然后使用这个宏的快捷键
后来,我还试验了编写宏,自动删除文档中所有的题注。这样是为了后面加入题注做好准备。
不过还是觉得需要手动查找表或者图,于是就又编写了一个宏,用于自动查找表格,然后插入题注。注意,这里没有自动查找图,是因为文章中有一些小图标不需要添加题注。
除了改题注,还要添加交叉引用,所以这些工作整整花了我两天的时间
我要问的问题:
能否有更好的方法实现题注的批量改变,比如说,给文档中所有的表格一次性自动加入题注,或者在已经有题注的情况下,统一更新题注的标签和编号方式。
希望大家能参与讨论此问题,来者有分,不够可加。
...全文
130 20 点赞 打赏 收藏 举报
写回复
20 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
xiaominli27 2004-05-09
学习一下。
  • 打赏
  • 举报
回复
icuc88 2004-05-09
不是人人都回VBA的,学习:)
  • 打赏
  • 举报
回复
yinliang66 2004-05-09
又学习了
  • 打赏
  • 举报
回复
ROBOT 2004-05-06
wonderful artical
  • 打赏
  • 举报
回复
shadow22 2004-05-06
up
  • 打赏
  • 举报
回复
eman1 2004-05-06
其实我不会写vba
不过因为有时候编写word工作量很大
就录制一些相关的宏修改修改,还是比较有用的
word里面有很多高级功能,大家多研究研究,相互交流,提高工作效率
  • 打赏
  • 举报
回复
eman1 2004-05-06
再给大家一段脚本,是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
  • 打赏
  • 举报
回复
lishentothenmuic 2004-05-05
怎么office也可以编代码的吗?
  • 打赏
  • 举报
回复
贝壳鱼 2004-05-05
good job!
  • 打赏
  • 举报
回复
duanshengyong 2004-05-05
楼主vba用得不错么,如果是我的话,就只好用菜单里的查找替换了,
  • 打赏
  • 举报
回复
yigepure 2004-05-05
哈哈,不错,水平很高嘛。
  • 打赏
  • 举报
回复
yinghuajie 2004-05-05
关注中
  • 打赏
  • 举报
回复
code菜鸟newbee 2004-05-05
又学习了
  • 打赏
  • 举报
回复
rnjan2000 2004-05-05
S s ...
  • 打赏
  • 举报
回复
smartpigeon 2004-05-05
up
  • 打赏
  • 举报
回复
eman1 2004-05-05
刚才上面的那个回答有点问题:
不能直接替换图表{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………
  • 打赏
  • 举报
回复
buddy_wu 2004-05-05
嗯,对的,不错啊。不过我认为还可以改进一下嘛,就是在事先没有给过题注的情况下也可以自动增加题注
  • 打赏
  • 举报
回复
eman1 2004-05-05
同理,对于表的题注的更新也可以采用这种方式
  • 打赏
  • 举报
回复
eman1 2004-05-05
呵呵,看来只有自问自答了,刚才研究了一种自动更新题注编号的方法:
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 2004-05-05
删除所有题注的宏代码如下,因为我的文档的图和表加起来不超过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
  • 打赏
  • 举报
回复
相关推荐
发帖
Microsoft Office应用
加入

6159

社区成员

Microsoft Office应用
申请成为版主
帖子事件
创建了帖子
2004-05-05 03:19
社区公告
暂无公告