word vba 中如何选中所有的表格啊？然后统一设置表格的格式？

雨雨♂专属

word vba 中如何选中所有的表格啊？然后统一设置表格的格式？
现在主要是怎么选择所有的表格不会弄。

413191246se

Sub 选中所有表格()
    Dim T As Table
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    For Each T In ActiveDocument.Tables
        T.Range.Editors.Add wdEditorEveryone
    Next
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub


*** 以下宏为循环遍历文档中所有表格，一个一个地处理，可选用：
Sub 表格处理()
    On Error Resume Next
    Dim i As Long
    i = ActiveDocument.Tables.Count
    If i = 0 Then MsgBox "当前文档无表格！", vbOKOnly + vbCritical, "表格处理": Exit Sub
    Dim a As Long, b As Long, c As String, h As String, s As String, t As Table, n As Long
    c = MsgBox("是：自动    否：自定义    取消：放弃", vbYesNoCancel + vbExclamation, "表格处理")
    If c = vbYes Then
        h = 0.9
        s = 12
        a = 1
        b = 1
    ElseIf c = vbNo Then
        h = InputBox("请输入表格行高值：(0.7-1.2 厘米比较美观)", "表格处理", "0.9")
        If h = "" Then Exit Sub
        s = InputBox("请输入表格内文字字号：(比正文小半号比较美观)" & vbCr & "三号/16磅，小三/15磅，四号/14磅，小四/12磅，五号/10.5磅", "表格处理", "12")
        If s = "" Then Exit Sub
        If MsgBox("根据内容调整表格吗？", vbYesNo + vbExclamation, "自动调整") = vbYes Then a = 1
        If MsgBox("所有表格表头加粗吗？", vbYesNo + vbExclamation, "表头加粗") = vbYes Then b = 1
    Else
        Exit Sub
    End If
    If Selection.Information(wdWithInTable) = True Then Selection.Tables(1).Select: n = 1
    For Each t In ActiveDocument.Tables
        If n = 1 Then Set t = Selection.Tables(1) Else t.Select
' 表格标准化
        With t
            With .Rows
                .WrapAroundText = False
                .Alignment = wdAlignRowLeft
                .HeightRule = wdRowHeightAtLeast
                .Height = CentimetersToPoints(h)
            End With
            .AutoFitBehavior (wdAutoFitWindow)
            .AutoFitBehavior (wdAutoFitWindow)
            With .Range
                With .Cells
                    .DistributeWidth
                    .VerticalAlignment = wdCellAlignVerticalCenter
                End With
                .Font.Size = s
                With .ParagraphFormat
                    .Alignment = wdAlignParagraphCenter
                    .CharacterUnitFirstLineIndent = 0
                    .FirstLineIndent = CentimetersToPoints(0)
                    .Space1
                End With
            End With
            .Shading.BackgroundPatternColor = wdColorAutomatic
' 根据内容调整表格
            If a = 1 Then
                .AutoFitBehavior (wdAutoFitContent)
                .AutoFitBehavior (wdAutoFitContent)
            End If
            .Select
            .AutoFitBehavior (wdAutoFitWindow)
            .AutoFitBehavior (wdAutoFitWindow)
' 表头加粗
            If b = 1 Then
                With .Rows(1).Range.Font
                    .Name = "黑体"
                    .Name = "Times New Roman"
                    .Bold = True
                End With
            End If
        End With
    Next
    If n <> 1 Then Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub

雨雨♂专属

不能一下子把所有表格格式都设置了么？不想循环去设置表格

413191246se

楼主，第一个宏可以选中所有表格，然后可以一次性设置为你所需要的样式或自动套用现成的表格样式，参见表格菜单；第二个宏仅为选用，是我自己设置的格式，可以选择自动方式。——两个宏是两种方法，你选择任意一个即可。

qinlei1024

楼主能帮我写个代码吗（文档有几十个表格）
全选表格 要求表格字体为宋体小五、
表格的属性为表格的指定宽度100%，行的指定行高为0.5 选项里面之选允许跨页断行，单元格字符自定宽度不选，垂直对其方式为居中。
段落设置：
对其方式为两端对其，大纲级别为正文文本；缩进设置 内外侧0；特殊格式为无； 如果定义了文档网络不选勾； 间距为0 ；行距：单倍行距  ，下面那些都不选勾
最后是根据窗口自动调整

413191246se

一是5楼你是不是说的是“楼上”而不是“楼主”？二是我2楼第二个代码你拷贝应用之就可以满足你的要求。建议备份文件后再操作，以免后悔。

kenny2095

413191246se 发表于 2012-5-22 17:27
一是5楼你是不是说的是“楼上”而不是“楼主”？二是我2楼第二个代码你拷贝应用之就可以满足你的要求。建议 ...

很有用，很受益，谢谢！

请教一下，如果我想在EXCEL调用这个VBA可以吗？应该怎么做？谢谢！

ghostmale

413191246se 发表于 2012-5-19 23:23
Sub 选中所有表格()
    Dim T As Table
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
...

挖坟抱歉我按照您的代码修改成了如下代码：
Sub 所有表格()
'
' 所有表格 宏
'
'
  Dim T As Table
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    For Each T In ActiveDocument.Tables
        T.Range.Editors.Add wdEditorEveryone
    Next
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    Selection.Font.Size = 10.5
    Selection.Font.Name = "Arial"
    Selection.Font.Name = "宋体"
    Selection.ParagraphFormat.LineSpacing = LinesToPoints(1)
    Selection.SelectCell
    Selection.Rows.Height = 22.6
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .WordWrap = True
    End With
End Sub

但为什么偏偏无法修改行高呢？小弟苦思半日，还是没有结果，希望大神解答一下，谢谢

ghostmale

413191246se 发表于 2012-5-19 23:23
Sub 选中所有表格()
    Dim T As Table
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
...

挖坟抱歉我按照您的代码修改成了如下代码：
Sub 所有表格()
'
' 所有表格 宏
'
'
  Dim T As Table
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    For Each T In ActiveDocument.Tables
        T.Range.Editors.Add wdEditorEveryone
    Next
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    Selection.Font.Size = 10.5
    Selection.Font.Name = "Arial"
    Selection.Font.Name = "宋体"
    Selection.ParagraphFormat.LineSpacing = LinesToPoints(1)
    Selection.SelectCell
    Selection.Rows.Height = 22.6
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .WordWrap = True
    End With
End Sub

但为什么偏偏无法修改行高呢？小弟苦思半日，还是没有结果，希望大神解答一下，谢谢

413191246se

行高 .Height = CentimetersToPoints(0.9)