请问一下可不可以把所有的表格全部设置一样？

幸运方格

   请问是否可以把所有的表格总高度、总宽度、字体样式、字体大小，段落间距，全部设置一样吗？

   所有表格左角对齐位置和右角对齐位置。


               

饮冰e士

录一段宏，然后循环执行，应该是可以的。

蜀中草莽

Sub tt()
    Dim b As Table
    For Each b In ActiveDocument.Tables
        b.Rows.WrapAroundText = False
        b.AutoFitBehavior (wdAutoFitWindow)
    Next
End Sub

幸运方格

蜀中草莽 发表于 2024-8-6 14:42
Sub tt()
    Dim b As Table
    For Each b In ActiveDocument.Tables

谢谢，效果不是太好。

蜀中草莽

幸运方格 发表于 2024-8-6 15:31
谢谢，效果不是太好。

只看了第二行  第一行的需求 给表格 应用个样式就可以了

幸运方格

蜀中草莽 发表于 2024-8-6 16:42
只看了第二行  第一行的需求 给表格 应用个样式就可以了

能不能把所有的表格左上角定位到指定的位置呢？然后全部统一字体样式、字体大小和表格底纹色。

我想统一定位在这里。

413191246se

* 楼主，请将代码复制到空白文档中，全选，剪切，再粘贴到 VBE 中，否则可能有乱码。
   
Sub a0807_TableProcess_Test()
'表格处理
    Dim t As Table, c As Cell, i As Paragraph, a&

    For Each t In ActiveDocument.Tables
        With t
            '取消环绕/左对齐/左缩进/行高(最小值)
            With .Rows
                .WrapAroundText = False
                .Alignment = wdAlignRowLeft
                .LeftIndent = CentimetersToPoints(0)
                .HeightRule = wdRowHeightAtLeast
                .Height = CentimetersToPoints(0.9)
            End With

            '清除格式
            With .Range
                .Next.InsertParagraphBefore
                .MoveEnd
                .Select
                Selection.ClearFormatting
                CommandBars.FindControl(ID:=122).Execute
                .MoveEnd 1, -1
                .Next.Delete
                With .Font
                    .NameFarEast = "宋体"
                    .NameAscii = "Times New Roman"
                    .Color = wdColorBlue
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True
                End With
                With .ParagraphFormat
                    .AutoAdjustRightIndent = False
                    .DisableLineHeightGrid = True
                End With
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter
            End With

            '删除空段
            For Each c In .Range.Cells
                For Each i In c.Range.Paragraphs
                    If Asc(i.Range) = 13 And Len(i.Range) = 1 Then i.Range.Delete
                Next
                With c.Range.Paragraphs
                    If .Count > 1 And Len(.Last.Range) = 2 Then .Last.Previous.Range.Characters.Last.Delete
                End With
            Next

            '表头加粗
            .Cell(1, 1).Select
            With Selection
                .SelectRow
                With .Font
                    .NameFarEast = "黑体"
                    .Bold = True
                    .Color = wdColorPink
                End With
                .Range.Find.Execute "[ 　^s^t]", , , 1, , , , , , "", 2
            End With

            .LeftPadding = CentimetersToPoints(0.19)
            .RightPadding = CentimetersToPoints(0.19)
            .AutoFitBehavior (wdAutoFitContent)
            .Select
            .AutoFitBehavior (wdAutoFitWindow)
            
'            .Range.Font.ColorIndex = wdAuto '自动色
        End With
    Next
    Selection.HomeKey Unit:=wdStory
End Sub

陈玉龙

蜀中草莽 发表于 2024-8-6 14:42
Sub tt()
    Dim b As Table
    For Each b In ActiveDocument.Tables

老师：vba 能实现选中文档中非标题、非表格、非图片的正文文字内容吗