请教word表格处理宏问题（涉及表格制表位）

lhw721

我这现有的表格处理宏有一些bug，也无法解决表格的制表位问题，还得请各位帮忙，谢谢！
Sub 表格处理()
    On Error Resume Next
    Dim t As Table, n As Long
    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 '左对齐
                .LeftIndent = CentimetersToPoints(0) '左缩进 0 厘米
                .HeightRule = wdRowHeightAtLeast '表格行高（最小值）
                .Height = CentimetersToPoints(0.65) '表格行高（0.65 厘米）
            End With
            With .Range
                With .Font '字体格式
                    .Name = "宋体"
                    .Name = "Times New Roman"
                    .Size = 10.5
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True
                End With
                With .ParagraphFormat '段落格式
                    .CharacterUnitFirstLineIndent = 0 '取消首行缩进
                    .FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
                    .LineSpacingRule = wdLineSpaceSingle '单倍行距（.Space1）
                    .Alignment = wdAlignParagraphCenter
                    .AutoAdjustRightIndent = False
                    .DisableLineHeightGrid = True
                End With
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter '垂直居中
            End With
            If .LeftPadding <> CentimetersToPoints(0.19) Then .LeftPadding = CentimetersToPoints(0.19) '默认单元格边距（0.19厘米）
            If .RightPadding <> CentimetersToPoints(0.19) Then .RightPadding = CentimetersToPoints(0.19) '默认单元格边距（0.19厘米）
            .AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
            .AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
            .Select
            .AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
            .AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
            With .Rows(1).Range.Font
                .Name = "宋体"
                .Name = "Times New Roman"
            End With
           Selection.Find.ClearFormatting '删除空格
           Selection.Find.Replacement.ClearFormatting
           With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        End With
    Options.DefaultBorderLineWidth = wdLineWidth050pt '调整表格线宽（表格内0.5磅，外边1.5磅）
    With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderHorizontal)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderVertical)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    Options.DefaultBorderLineWidth = wdLineWidth150pt
    With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
        If n = 1 Then Exit For
        Next
    End Sub




表格格式处理宏优化.zip (17 KB, 下载次数: 16)

2021-5-24 08:33 上传

点击文件名下载附件

lhw721

采用 Selection.ClearFormatting '清除文字格式即可解决问题

413191246se

楼主，制表位我并未考虑，一般表格中的文字均是居中，请试试下面的新宏：

1. Sub 表格处理()
   
2. '功能：（3合1）
   
3. '1.如果选定区域，则处理选定区域表格；
   
4. '2.否则，如果光标在表格中，则处理当前表格；
   
5. '3.如果光标在表格外，则处理所有表格。
   
6. 
   
7.     Dim r As Range, t As Table, c As Cell, i As Paragraph, j As Long
   
8. 
   
9.     With Selection
   
10.         If .Type = wdSelectionIP Then
    
11.             If .Information(wdWithInTable) = True Then
    
12.                 Set t = .Tables(1)
    
13.                 Set r = .Tables(1).Range
    
14.             Else
    
15.                 Set r = ActiveDocument.Content
    
16.             End If
    
17.         Else
    
18.             Set r = .Range
    
19.         End If
    
20.     End With
    
21. 
    
22.     For Each t In r.Tables
    
23.         With t
    
24.             '取消环绕/左对齐/左缩进/行高0.9厘米
    
25.             With .Rows
    
26.                 .WrapAroundText = False
    
27.                 .Alignment = wdAlignRowLeft
    
28.                 .LeftIndent = CentimetersToPoints(0)
    
29.                 .HeightRule = wdRowHeightAtLeast
    
30.                 .Height = CentimetersToPoints(0.9)
    
31.             End With
    
32. 
    
33.             '清除格式
    
34.             With .Range
    
35.                 .Find.Execute "[^13^l]", , , 1, , , , , , "^p", 2
    
36.                 .Next.InsertParagraphBefore
    
37.                 .Select
    
38.                 With Selection
    
39.                     .MoveEnd
    
40.                     .ClearFormatting
    
41.                 End With
    
42.                 CommandBars.FindControl(ID:=122).Execute
    
43.                 With .Font
    
44.                     .Size = 12
    
45.                     .Color = wdColorBlue
    
46.                     .Kerning = 0
    
47.                     .DisableCharacterSpaceGrid = True
    
48.                 End With
    
49.                 With .ParagraphFormat
    
50.                     .AutoAdjustRightIndent = False
    
51.                     .DisableLineHeightGrid = True
    
52.                 End With
    
53.                 .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
54.                 .Next.Delete
    
55.             End With
    
56. 
    
57.             .LeftPadding = CentimetersToPoints(0.19)
    
58.             .RightPadding = CentimetersToPoints(0.19)
    
59.             .AutoFitBehavior (wdAutoFitContent)
    
60.             .Select
    
61.             .AutoFitBehavior (wdAutoFitWindow)
    
62. 
    
63.             '删除空段
    
64.             For Each c In .Range.Cells
    
65.                 For Each i In c.Range.Paragraphs
    
66.                     If Asc(i.Range) = 13 And Len(i.Range) = 1 Then i.Range.Delete
    
67.                 Next
    
68.                 With c.Range.Paragraphs
    
69.                     If .Count > 1 And Len(.Last.Range) = 2 Then .Last.Previous.Range.Characters.Last.Delete
    
70.                 End With
    
71.             Next
    
72. 
    
73.             '表头加粗
    
74.             .Cell(1, 1).Select
    
75.             Selection.SelectRow
    
76.             With Selection.Font
    
77.                 .NameFarEast = "黑体"
    
78.                 .Bold = True
    
79.                 .Color = wdColorRed
    
80.             End With
    
81.         End With
    
82.     Next
    
83. End Sub

复制代码

lhw721

413191246se 发表于 2021-5-24 20:09
楼主，制表位我并未考虑，一般表格中的文字均是居中，请试试下面的新宏：

老大，可否能帮我加上删除空段的代码？万分感谢！

Sub 表格处理2()
    Selection.ClearFormatting '清除文字格式
    CommandBars("Styles").Visible = False '字体格式
    Selection.Font.Name = "宋体" '中文字体格式
    Selection.Font.Name = "Times New Roman" '西文字体格式
    Selection.Font.Size = 10.5 '5号字体
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '文字居中
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
    Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(0)
    Selection.Rows.HeightRule = wdRowHeightAtLeast
    Selection.Rows.Height = CentimetersToPoints(0.65) '表格行高（0.65 厘米）
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Options.DefaultBorderLineWidth = wdLineWidth050pt '调整表格内线宽内0.5磅
    With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderHorizontal)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderVertical)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    Options.DefaultBorderLineWidth = wdLineWidth150pt '调整表格外线宽1.5磅
    With Selection.Borders(wdBorderTop)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderRight)
        .LineStyle = Options.DefaultBorderLineStyle
        .LineWidth = Options.DefaultBorderLineWidth
        .Color = Options.DefaultBorderColor
    End With
End Sub

413191246se

楼主，如果你说的“删除空段”是指表格内的空段，则上面《表格处理》宏已经包括了！还请试用下面的宏：

1. Sub 删除空行()
   
2.     Dim i As Paragraph
   
3.     For Each i In ActiveDocument.Paragraphs
   
4.         If Asc(i.Range) = 13 Then i.Range.Delete
   
5.     Next
   
6. End Sub

复制代码

1. Sub 删除表格空行()
   
2.     Dim t As Table, s As Long, r As Row
   
3.     If Selection.Information(wdWithInTable) = True Then s = 1
   
4.     For Each t In ActiveDocument.Tables
   
5.         If s = 1 Then Set t = Selection.Tables(1)
   
6.         With t
   
7.             If .Uniform = False Then GoTo sk
   
8.             With .Range
   
9.                 .Rows.WrapAroundText = False
   
10.                 .Next.InsertParagraphBefore
    
11.                 .Find.Execute "[^13^l]", , , 1, , , , , , "^p", 2
    
12.             End With
    
13.             .Select
    
14.             With Selection
    
15.                 .MoveEnd
    
16.                 CommandBars.FindControl(ID:=122).Execute
    
17.                 .Characters.Last.Delete
    
18.             End With
    
19.             For Each r In .Rows
    
20.                 If Len(Replace(Replace(r.Range.Text, vbCr, ""), Chr(7), "")) = 0 Then r.Delete
    
21.             Next
    
22.         End With
    
23.         If s = 1 Then Exit For
    
24. sk:
    
25.     Next
    
26. End Sub

复制代码

lhw721

413191246se 发表于 2021-5-25 17:14
楼主，如果你说的“删除空段”是指表格内的空段，则上面《表格处理》宏已经包括了！还请试用下面的宏：

收到，谢谢！