麻烦大家帮我修改一下WORD表格自动处理的代码

lhw721 · 发表于 2015-11-18 11:50

因此我们专业报告是由各专业的人编写再汇总，大家的表格编制格式都不一样，所以最后报告汇总时需调整所有的表格，工作量很大。我这个有别人的宏代码，它会自动处理表格，不过它处理的格式与我们的要求不太一样，还请大家帮我看看要怎么修改这段代码。表格处理前后的格式详见附件，若是可以连表格上面的表名和表格编号的格式也一起修改，那是最好。谢谢！

参考代码：

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
            .HeightRule = wdRowHeightAtLeast
            .Height = CentimetersToPoints(0.9)
         End With
         With .Range
            With .Cells
                  .DistributeWidth
                  .VerticalAlignment = wdCellAlignVerticalCenter
            End With
            .Font.Size = 12
            With .ParagraphFormat
                  .Alignment = wdAlignParagraphCenter
                  .CharacterUnitFirstLineIndent = 0
                  .FirstLineIndent = CentimetersToPoints(0)
                  .Space1
            End With
         End With
         .Shading.BackgroundPatternColor = wdColorAutomatic
         .AutoFitBehavior (wdAutoFitContent)
         .AutoFitBehavior (wdAutoFitContent)
         .Select
         .AutoFitBehavior (wdAutoFitWindow)
         .AutoFitBehavior (wdAutoFitWindow)
         With .Rows(1).Range.Font
            .Name = "黑体"
            .Name = "Times New Roman"
            .Bold = True
         End With
      End With
      If n = 1 Then Exit For
Next
End Sub

lhw721 · 发表于 2015-11-18 14:50

好像我自己搞定了，修改后的代码如下：

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
            .HeightRule = wdRowHeightAtLeast
            .Height = CentimetersToPoints(0.9)
         End With
         With .Range
            With .Cells
                  .DistributeWidth
                  .VerticalAlignment = wdCellAlignVerticalCenter
            End With
            .Font.Size = 10.5
            With .ParagraphFormat
                  .Alignment = wdAlignParagraphCenter
                  .CharacterUnitFirstLineIndent = 0
                  .FirstLineIndent = CentimetersToPoints(0)
                  .Space1
            End With
         End With
         .Shading.BackgroundPatternColor = wdColorAutomatic
         .AutoFitBehavior (wdAutoFitContent)
         .AutoFitBehavior (wdAutoFitContent)
         .Select
         .AutoFitBehavior (wdAutoFitWindow)
         .AutoFitBehavior (wdAutoFitWindow)
         With .Rows(1).Range.Font
            .Name = "宋体"
            .Name = "Times New Roman"
         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
      End With
      If n = 1 Then Exit For
Next
End Sub

lhw721 · 发表于 2015-11-18 15:15

我二楼发的代码还是有问题，很多表格还是没有办法把字体全部改为宋体字

413191246se · 发表于 2015-11-18 16:25

呵呵，楼主，原来的代码是我编的——如果光标未在表格中，循环遍历处理所有表格（如果光标在表格中，则处理当前表格），你把下面两句代码放到第6句代码 With t 下面一行即可：（把原来的“宋体”改回“黑体”，它是把表头，即表格第一行变为黑体加粗-----我打开你的附件文档后，看不到文档内容，是乱码，如果问题没有解决，请重新上传附件）
t.Range.Font.Name = "宋体"
t.Range.Font.Name = "Times New Roman"

loquat · 发表于 2015-11-19 06:24

试试看

Sub 表格处理()
On Error Resume Next
Dim t As Table, n As Long
For Each t In ActiveDocument.Tables
With t.Rows
.WrapAroundText = False
.Alignment = wdAlignRowLeft
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(0.9)
End With
With t.Range
.Font.Name = "宋体"
.Font.Name = "Times New Roman"
.Font.Size = 10.5
With .Cells
.DistributeWidth
.VerticalAlignment = wdCellAlignVerticalCenter
End With
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
.Space1
End With
End With
t.Shading.BackgroundPatternColor = wdColorAutomatic
t.AutoFitBehavior (wdAutoFitContent)
t.AutoFitBehavior (wdAutoFitWindow)
Options.DefaultBorderLineWidth = wdLineWidth150pt
With t.Borders(wdBorderTop)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With t.Borders(wdBorderLeft)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With t.Borders(wdBorderBottom)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With t.Borders(wdBorderRight)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
Next
End Sub

复制代码

lhw721 · 发表于 2015-11-19 08:15

谢谢楼上各位的帮忙，问题解决了，谢谢！

413191246se · 发表于 2015-11-19 09:15

主要是 loquat 帮的忙。。。

		自动登录	找回密码
密码			免费注册

[求助] 麻烦大家帮我修改一下WORD表格自动处理的代码