Word2019中Visio对象图片插入题注时自动删除标签与编号前的空格,编号后添加空格

问题引入

撰写论文时为了修改方便,通常以插入题注和交叉引用的方式来给图片标号,这样修改图片和图号后可以方便、自动地更新。

然而,Word在插入题注上从03到13一直没有针对中国用户优化。

  1. 插入题注的标签与编号间有一个空格,当标签是中文时需要用户手动删除
  2. 标签后竟然不插入空格!

新浪微博大神Endlesswx通过宏编程很好地解决了这个问题,具体请看新浪博客

Word插入题注时自动删除标签与编号前的空格,编号后添加空格

  • 例如,我们给图片A添加题注:图1+空格符+图片A
  • Word自带的添加题注功能添加后为:图+空格符+1
  • 而我们想要的效果是:图1+空格符

问题分析

当你在Word2019中对Visio对象的图片(Visio中画的图直接组合复制到word中)通过上面这个宏去操作的时候,会出现问题,经过调试发现,问题在这儿

 Selection.Fields.ToggleShowCodes  '切换域代码,这样才能用^d查找域

这句代码的主要思路是:将题注的标签和编号一起选中,即将图1切换为域代码,然后通过^d查找域的方法(具体不太懂,但没关系)来找关键字,然后进行替换,达成我们想要的目的。

'选定整个插入的题注内容,将域代码切换回来
 endPt = endPt + 1 '增加空格后,末位加1
 With Selection
    .Start = startPt
    .End = endPt
    .Fields.ToggleShowCodes   '切换域代码(切换回来)
 End With

这段代码的功能是:将修改后的图+标签+编号一起选中,然后从域代码切换回来。需要注意的地方是这段代码会将图片也选中,当图片是普通的图片时,当然没有任何问题;但当图片是Visio对象图片时,问题就来了,这段代码会将Visio对象图片切换为一串代码。

问题解决

究其原因就是切换回来的时候连图片也选中了,那么就好办了,我们让它切换的时候还是只选中标签+编号,然后再执行切换代码即可(当然你也可以在Word中手动再切换回来)。

经过调试,更改这段代码,将标签的位置设置为起始位置即可

更改前:

'删除标签与编号间的空格(英文后的保留)
 With Selection.Find
    .Text = Lab & " "
    .Forward = True   'False=向上查找,(True=向下查找)
    .MatchWildcards = False '不使用通配符
    If Lab Like "*[0-9a-zA-Z.]" Then  '此处判断标签的最后一个字符是否为英文或数字,是则不删除空格
    Else
       .Replacement.Text = Lab
       .Execute Replace:=wdReplaceOne  '替换找到的第一个,此处用作删除空格
       endPt = endPt - 1 '删除空格后,末位减1
       Selection.End = endPt
    End If
 End With

更改后:

'删除标签与编号间的空格(英文后的保留)
With Selection.Find
   .Text = Lab & " " '图+空格
   .Forward = True   'False=向上查找,(True=向下查找)
   .MatchWildcards = False '不使用通配符
   If Lab Like "*[0-9a-zA-Z.]" Then  '此处判断标签的最后一个字符是否为英文或数字,是则不删除空格
   Else
      .Replacement.Text = Lab
      .Execute Replace:=wdReplaceOne  '替换找到的第一个,此处用作删除空格
      endPt = endPt - 1 '删除空格后,末位减1
      startPt = Selection.Start '更改的代码
      Selection.End = endPt
   End If
End With

倒数第4行为新加入的代码,这样就不会修改Visio对象图片了,完美解决。

完整宏代码

Sub InsertCaption()  '修改系统插入“题注”命令

   '功能:自动删除标签与编号间的空格(英文除外),并在题注数字后添加一个空格;适用于:Word 2003 - 2013,不兼容WPS文字!
  '真正从原理上协同系统插入题注,无任何前提条件;用户照常插入题注即可,甚至感觉不到程序的存在!
   'Endlesswx于2015年8月4日
   
  '另,如果插入的始终未域代码而不是数字,非程序问题,Alt+F9一次即可
   
   Dim Lab As String, startPt As Long, endPt As Long, myrang As Range
   'On Error Resume Next  '发生错误时让程序继续执行下一句代码
'    Application.ScreenUpdating = False     '关闭屏幕更新,2013在此处关闭更新会导致输入框灰色不可选,故修正在调出对话框之后
   
   startPt = Selection.Start  'startPt标注起始点
      
   '***将if条件隐藏隐藏即可实现----手动替换题注空格***
   If Application.Dialogs(357).Show = -1 Then '插入“题注”对话框秀出来,如果按确定结束时执行以下程序,避免按取消后的空格,357也可换成wdDialogInsertCaption
      
      Application.ScreenUpdating = False     '关闭屏幕更新
      
       Lab = Dialogs(357).Label
       endPt = Selection.Start  'endPt标记插入的题注部分终点
      Selection.Start = startPt  '选定插入的整个题注
      
      '删除标签与编号间的空格(英文后的保留)
       With Selection.Find
          .Text = Lab & " " '图+空格
          .Forward = True   'False=向上查找,(True=向下查找)
          .MatchWildcards = False '不使用通配符
          If Lab Like "*[0-9a-zA-Z.]" Then  '此处判断标签的最后一个字符是否为英文或数字,是则不删除空格
          Else
             .Replacement.Text = Lab
             .Execute Replace:=wdReplaceOne  '替换找到的第一个,此处用作删除空格
             endPt = endPt - 1 '删除空格后,末位减1
             startPt = Selection.Start
             Selection.End = endPt
          End If
       End With
      
      '在题注数字后添加一个空格
      Selection.Fields.ToggleShowCodes  '切换域代码,这样才能用^d查找域
       With Selection.Find
          .Text = "^d"
          .Replacement.Text = "^& "
          .Forward = False   'False=向上查找,(True=向下查找)
          .MatchWildcards = False '不使用通配符
          .Execute Replace:=wdReplaceOne  '替换找到的第一个,此处用作添加空格
       End With
      
      '选定整个插入的题注内容,将域代码切换回来
       endPt = endPt + 1 '增加空格后,末位加1
       With Selection
          .Start = startPt
          .End = endPt
          .Fields.ToggleShowCodes   '切换域代码(切换回来)
       End With
      
      '将光标定位至题注所在段尾处
'       Selection.MoveRight Unit:=wdCharacter, Count:=1  '此句光标返回插入题注前的原始位置,对于已经输好标题的情况并不合适
      '选择段尾回车符
       With Selection.Find
          .Text = "^13"
          .Forward = True   'False=向上查找,(True=向下查找)
          .MatchWildcards = False  '不使用通配符
          .Wrap = wdFindContinue '继续查找
          .Execute
       End With
      Selection.MoveLeft Unit:=wdCharacter, Count:=1  '定位到段尾回车前

   End If
   Application.ScreenUpdating = True          '恢复屏幕更新
   
End Sub

感悟

程序猿就是好啊,自己动手,丰衣足食,哈哈哈!!!

欢迎关注,不断更新中……

在这里插入图片描述

相关推荐

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:技术黑板 设计师:CSDN官方博客 返回首页
评论 9

打赏作者

通信与逆向那些事

对学生党 赞赏是鼓励也是鞭策!

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值