vba批量化调整word的图和图表标题

vba 复制代码
   ' 将图片进行居中操作
Sub ChangePictureFormate()
    Dim oPara As Paragraph
    Dim oRange As Range
    Dim i As Long
    Dim beforeIsPicture As Boolean
    beforesIsPicture = False

    ' 确保文档中至少有图片
    If ActiveDocument.InlineShapes.Count = 0 Then
        MsgBox "没有找到图片。"
        Exit Sub
    End If

    ' 遍历所有段落
    For Each oPara In ActiveDocument.Paragraphs
        ' 检查段落是否包含图片
       
        
'wdAlignParagraphLeft:         左对齐
'wdAlignParagraphCenter: 居中对齐
'wdAlignParagraphRight: 右对齐
'wdAlignParagraphJustify: 两端对齐
'wdAlignParagraphDistribute：分散对齐（文本均匀分布在行的左右两边
           
        
        '所有的图片居右操作
        If oPara.Range.InlineShapes.Count > 0 Then
            oPara.Alignment = wdAlignParagraphRight

        End If
              
    Next oPara
    MsgBox "程序运行完成！"
End Sub
   ' 更改图片标题
Sub ChangePictureLabelFormate()
    Dim oPara As Paragraph
    Dim oRange As Range
    Dim i As Long
    Dim beforeParaIsPicture As Boolean
    beforeParaIsPicture = False

    ' 确保文档中至少有图片
    If ActiveDocument.InlineShapes.Count = 0 Then
        MsgBox "没有找到图片。"
        Exit Sub
    End If

    ' 遍历所有段落
    For Each oPara In ActiveDocument.Paragraphs

        Debug.Print oPara.Range.Text
        Debug.Print beforeParaIsPicture
        If (beforeParaIsPicture = True) Then
           'Debug.Print 1
           oPara.Range.Font.Bold = True
           oPara.Alignment = wdAlignParagraphLeft
        End If
        If oPara.Range.InlineShapes.Count > 0 Then
            '选中下一个自然段
           'Set oRange = oPara.Range
           'oRange.Collapse Direction:=wdCollapseEnd
           'oRange.Move Unit:=wdParagraph, Count:=1
           'oRange.Font.Bold = True
           'MsgBox oRange.Text
           beforeParaIsPicture = True
        Else
            beforeParaIsPicture = False
        End If
    Next oPara
    'MsgBox "程序运行完成！"
End Sub

''对所有的表格进行批量化的操作
Sub ChangeAllTables()
    Dim tbl As Table
    Dim selectionRange As Range
    
    ' 创建一个新的 Range 对象以存储所有表格的合并范围
    Set selectionRange = ActiveDocument.Range
    
    ' 遍历每个表格并扩展选择的范围
    For Each tbl In ActiveDocument.Tables
    
    
        With tbl
            .PreferredWidthType = wdPreferredWidthPercent
            .PreferredWidth = 100
            .Range.Rows.Alignment = wdAlignRowCenter
        End With
        
        For Each Cell In tbl.Range.Cells
            ' 更改单元格内所有文本的字体大小
            
            With Cell.Range
                .Font.Name = "宋体"
                .Font.Name = "Times New Roman"
                .Font.Size = 12 ' 设置为24号字
                .ParagraphFormat.Alignment = wdAlignParagraphRight
            End With
           
        Next Cell
    Next tbl
    
    Debug.Print "所有表格调整完毕"

End Sub

''更改所有表格的图例
Sub SetFontSizeAboveTables()
    Dim tbl As Table
    Dim rng As Range
    
    ' 遍历文档中的所有表格
    For Each tbl In ActiveDocument.Tables
        ' 设置 rng 为表格上方的段落
        Set rng = tbl.Range
        rng.MoveStart wdParagraph, -1 ' 移动到表格的前一个段落
        rng.MoveEnd wdParagraph, 1 ' 种回到表格的结尾
        
        ' 设置上方段落的字体大小为 12
        If rng.Paragraphs.Count > 0 Then
            rng.Paragraphs(1).Range.Font.Size = 28
            rng.Paragraphs(1).Range.Font.Name = "宋体"
            rng.Paragraphs(1).Range.Font.Name = "Times New Roman"
        End If
    Next tbl
End Sub