Word-通过宏格式化文档中的表格和图片

1、打开Word文档，找到”视图“，然后点击”宏“。

 

2、创建宏脚本。

Sub A表格格式化()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim tbl As Table, cell As cell
    Dim counter As Integer: counter = 1
    Dim response As VbMsgBoxResult
    Dim r As Long, c As Long
    
    ' 遍历文档中所有表格
    For Each tbl In ActiveDocument.Tables
        
        ' --- 核心设置 ---
        ' 设置表格宽度
        tbl.PreferredWidthType = wdPreferredWidthPercent      ' 宽度度量单位：百分比
        tbl.PreferredWidth = 98                               ' 百分比
        tbl.AllowAutoFit = False
        
        ' 设置表格所在段落的行距
        tbl.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        tbl.Range.ParagraphFormat.SpaceBefore = 0
        tbl.Range.ParagraphFormat.SpaceAfter = 0
        
        ' 设置表格整体对齐
        tbl.Rows.Alignment = wdAlignRowCenter
        
        ' --- 边框设置（支持合并单元格）---
        With tbl.Borders
            .Enable = True
            .OutsideLineStyle = wdLineStyleSingle
            .OutsideLineWidth = wdLineWidth050pt
            .InsideLineStyle = wdLineStyleSingle
            .InsideLineWidth = wdLineWidth050pt
        End With
        
        ' --- 逐个单元格处理（避免合并单元格错误）---
        For r = 1 To tbl.Rows.Count
            For c = 1 To tbl.Columns.Count
                ' 跳过合并单元格中的重复单元格
                If tbl.cell(r, c).rowIndex = r And tbl.cell(r, c).ColumnIndex = c Then
                    
                    With tbl.cell(r, c)
                        ' 设置单元格垂直对齐
                        .VerticalAlignment = wdCellAlignVerticalCenter
                        
                        ' 设置段落水平对齐
                        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        
                        ' 设置字体
                        .Range.Font.Name = "宋体"
                        .Range.Font.NameFarEast = "宋体"
                        .Range.Font.Size = 10.5
                        .Range.Font.Color = RGB(0, 0, 0)
                        
                        ' 设置首行格式
                        If r = 1 Then
                            .Range.Font.Bold = True
                            .Shading.BackgroundPatternColor = RGB(242, 242, 242)
                        Else
                            .Range.Font.Bold = False
                            .Shading.BackgroundPatternColor = wdColorAutomatic
                        End If
                    End With
                    
                End If
            Next c
        Next r
        
        ' --- 设置行高 ---
        ' 单独处理每行，避免合并单元格影响
        For r = 1 To tbl.Rows.Count
            On Error Resume Next
            tbl.Rows(r).Height = CentimetersToPoints(0.8)  ' 调整为0.8厘米，更紧凑
            tbl.Rows(r).HeightRule = wdRowHeightAtLeast
        Next r
        
        ' --- 每20个表格提示一次 ---
        If counter Mod 20 = 0 Then
            response = MsgBox("已处理第 " & counter & " 个表格" & vbNewLine & _
                              "点击【确定】继续，【取消】中止", _
                              vbOKCancel + vbInformation, "批量进度提示")
            
            If response = vbCancel Then
                Application.ScreenUpdating = True
                MsgBox "操作已中止！共完成 " & (counter - 1) & " 个表格", vbExclamation, "表格样式设置"
                Exit For
            End If
        End If
        counter = counter + 1
        
    Next tbl
    
    ' 收尾处理
    Application.ScreenUpdating = True
    If response <> vbCancel Then
        MsgBox "表格设置已完成！" & vbCrLf & vbCrLf & _
               "所有表格已设置为页面宽度、居中对齐" & vbCrLf & _
               "支持合并单元格的复杂表格" & vbCrLf & vbCrLf & _
               "共处理 " & (counter - 1) & " 个表格", _
               vbInformation, "表格样式设置"
    End If
End Sub


'' 厘米转磅函数（1厘米=28.35磅）
Function CentimetersToPoints(ByVal cm As Single) As Single
    CentimetersToPoints = cm * 28.35
End Function



Sub B图片格式化()
    ' 声明变量
    Dim shp As Shape
    Dim ilshp As InlineShape
    Dim pageWidth As Single
    Dim leftMargin As Single
    Dim rightMargin As Single
    Dim usableWidth As Single
    
    ' 关闭屏幕更新以提高宏运行速度
    Application.ScreenUpdating = False
    
    ' 设置错误处理，跳过无法处理的图片
    On Error Resume Next
    
    ' 计算页面可用宽度（点数）
    With ActiveDocument.PageSetup
        pageWidth = .pageWidth
        leftMargin = .leftMargin
        rightMargin = .rightMargin
    End With
    
    ' 计算可用宽度 = 页面宽度 - 左边距 - 右边距
    usableWidth = pageWidth - leftMargin - rightMargin
    
    ' 第一部分：处理嵌入型图片（InlineShapes）
    For Each ilshp In ActiveDocument.InlineShapes
        If ilshp.Type = wdInlineShapePicture Or ilshp.Type = wdInlineShapeLinkedPicture Then
            ' 设置图片宽度为页面可用宽度
            ilshp.Width = usableWidth
            ' ★ 新增：取消首行缩进并设置居中对齐
            With ilshp.Range.ParagraphFormat
                .CharacterUnitFirstLineIndent = 0    ' 取消字符单位首行缩进
                .FirstLineIndent = 0                 ' 取消磅单位首行缩进
                .Alignment = wdAlignParagraphCenter   ' 段落后中包括图片
            End With
        End If
    Next ilshp
    
    ' 第二部分：处理浮动型图片（Shapes）
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            ' 锁定纵横比，设置宽度为页面可用宽度
            shp.LockAspectRatio = msoTrue
            shp.Width = usableWidth
            ' ★ 新增：通过锚定段落取消首行缩进并居中对齐
            If Not shp.Anchor Is Nothing Then
                With shp.Anchor.ParagraphFormat
                    .CharacterUnitFirstLineIndent = 0
                    .FirstLineIndent = 0
                    .Alignment = wdAlignParagraphCenter
                End With
            End If
        End If
    Next shp
    
    ' 完成提示（更新提示文本）
    MsgBox "图片设置已完成！" & vbCrLf & vbCrLf & _
           "所有图片已设置为页面宽度、居中对齐，并取消首行缩进。", _
           vbInformation, "图片样式设置"
    
    ' 重新开启屏幕更新
    Application.ScreenUpdating = True
End Sub

 

3、运行宏脚本，选中"A表格格式化"，点击”运行“ 按钮，即可格式化表格。

 执行完成后，弹出对话框。

4、运行宏脚本，选中"B图片格式化"，点击”运行“ 按钮，即可格式化图片。

  执行完成后，弹出对话框。