word文档使用技巧----一键插入题注

这个学期某课程word文档报告需要图片有题注才给较高的分数，一张张图片打题注非常麻烦，网上搜到用脚本插入题注的方法，修改了一下，方便下次直接复制。
在word的开发工具选择Visual Basic-->插入-->模块-->粘贴代码后F5执行，然后删除模块，保存。

Sub CaptionPictures()
    Dim xPic As InlineShape
    Dim picPage As Integer ' 存储图片所在页码
    
    For Each xPic In ActiveDocument.InlineShapes
        ' 获取当前图片所在的页码（wdActiveEndPageNumber对应常量3，代表范围结束位置的页码）
        picPage = xPic.Range.Information(3)
        
        ' 仅当页码不是第1页时，才插入题注
        If picPage <> 1 Then
            xPic.Select
            Selection.InsertCaption "图", "", "", wdCaptionPositionBelow, 0
        End If
    Next
End Sub

增强版：

Sub CaptionPictures()
    Dim xPic As InlineShape
    Dim picPage As Integer ' 存储图片所在页码
    Dim currentRange As Range ' 用于保存当前位置
    
    For Each xPic In ActiveDocument.InlineShapes
        ' 获取当前图片所在的页码（wdActiveEndPageNumber对应常量3，代表范围结束位置的页码）
        picPage = xPic.Range.Information(3)
        
        ' 仅当页码不是第1页时，才插入题注
        If picPage <> 1 Then
            xPic.Select
            Selection.InsertCaption "图", "", "", wdCaptionPositionBelow, 0
            
            ' 设置题注格式
            Set currentRange = Selection.Range ' 保存当前题注的范围
            With currentRange
                ' 设置为居中对齐
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                
                ' 设置为五号字体（10.5磅）
                .Font.Size = 10.5 ' 五号对应10.5磅
                
                ' 确保题注是单倍行距
                .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            End With
        End If
    Next
End Sub