http://s16/mw690/001uxDDvzy6UnvQ4I7t7f&690

1.  程序是调用系统的“插入题注对话框”，以前怎么插题注现在还怎么用，零学习成本与多余步骤

2.  中文与编号间空格删除，英文与编号见空格保留（见动态图中第3个Figure）

3.  编号数字与题注内容见添加一个空格，予以区分

其实程序还支持插入时不填内容、在文档中输好的内容前插入等等，自行体验吧。

第一步：录制一个宏（主要为了创建NewMacros模块，以前录制过的请跳过此步）

03：工具→宏→录制新宏→确定→单击“停止”按钮

10：单击WORD状态栏的录制宏按钮（或开发工具→录制宏）→确定→单击“停止”按钮 

第二步：ALT+F11（打开VBA对话框）

将以上代码粘贴到打开的NewMacros模块中

第三步：用系统的插入题注即可

另，本人会为插入题注设置快捷键Alt+[，这个看个人喜好，设置方法参见另一博文：文本从PDF等粘贴到WORD中，智能删除多余的空格和回车中使用方法部分

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

                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

*原创内容，转载请注明出处*