Word图注排版技巧:编号与内容间空格处理

Sub InsertCaption()  '修改系统插入“题注”命令   '功能：自动删除标签与编号间的空格（英文除外），并在题注数字后添加一个空格；   '同时自动创建“图”“表”两个题注标签   '适用于：Word 2003 - 2013，不兼容WPS文字！   Dim Lab As String, startPt As Long, endPt As Long, myrang As Range   '每次打开“插入题注”对话框前，先确保有“图”“表”两个标签   Call EnsureCaptionLabel("图")   Call EnsureCaptionLabel("表")   Call EnsureCaptionLabel("Fig")   Call EnsureCaptionLabel("Tab")   startPt = Selection.Start  'startPt标注起始点   If Application.Dialogs(357).Show = -1 Then '插入“题注”对话框秀出来，如果按确定结束时执行以下程序      Application.ScreenUpdating = False     '关闭屏幕更新      Lab = Dialogs(357).Label      endPt = Selection.Start  'endPt标记插入的题注部分终点      Selection.Start = startPt  '选定插入的整个题注      '删除标签与编号间的空格（英文后的保留）      With Selection.Find          .Text = Lab & " "          .Forward = True          .MatchWildcards = False          If Lab Like "*[0-9a-zA-Z.]" Then              '如果标签最后一个字符是英文、数字或点号，则保留空格          Else              .Replacement.Text = Lab              .Execute Replace:=wdReplaceOne              endPt = endPt - 1              Selection.End = endPt          End If      End With      '在题注数字后添加一个空格      Selection.Fields.ToggleShowCodes  '切换域代码，这样才能用^d查找域      With Selection.Find          .Text = "^d"          .Replacement.Text = "^& "          .Forward = False          .MatchWildcards = False          .Execute Replace:=wdReplaceOne      End With      '选定整个插入的题注内容，将域代码切换回来      endPt = endPt + 1      With Selection          .Start = startPt          .End = endPt          .Fields.ToggleShowCodes      End With      '将光标定位至题注所在段尾处      With Selection.Find          .Text = "^13"          .Forward = True          .MatchWildcards = False          .Wrap = wdFindContinue          .Execute      End With      Selection.MoveLeft Unit:=wdCharacter, Count:=1  '定位到段尾回车前   End If   Application.ScreenUpdating = True          '恢复屏幕更新End SubPrivate Sub EnsureCaptionLabel(ByVal LabelName As String)    '如果题注标签不存在，则自动创建；    '如果已经存在，则不重复创建，避免报错。    Dim cap As captionLabel    Dim exists As Boolean    exists = False    For Each cap In Application.CaptionLabels        If cap.Name = LabelName Then            exists = True            Exit For        End If    Next cap    If exists = False Then        Application.CaptionLabels.Add Name:=LabelName    End IfEnd Sub