word调整全文的表格为字体和行距的宏什么写呢？

o0star0o · 发表于 2021-11-24 18:28

Sub 表格全部紧缩()
'1.如果选定区域，则处理选定区域表格；
'2.否则，如果光标在表格中，则处理当前表格；
'3.如果光标在表格外，则处理所有表格。
Dim t As Table, r As Range
With Selection
If .Type = wdSelectionIP Then
If .Information(wdWithInTable) = True Then
Set t = .Tables(1)
Set r = .Tables(1).Range
Else
Set r = ActiveDocument.Content
End If
Else
Set r = .Range
End If
End With
For Each t In r.Tables
With t
With .Rows
.WrapAroundText = False
.Alignment = wdAlignRowCenter
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(0)
End With
With .Range
With .Font
.Size = 10
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.Space1
.Alignment = wdAlignParagraphCenter
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
End With
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
End With
.AutoFitBehavior (wdAutoFitContent)
End With
Next
End Sub

复制代码

之前有个这个宏，看能用上不，但是这个宏的功能是调整表格缩进目前需要：
将全文中的表格(全文可能有文章，可能有表格)，设置为“五号”字体、“1.0倍行距”
请问这种宏什么实现呢?

413191246se · 发表于 2021-11-25 01:37

本帖最后由 413191246se 于 2021-11-27 21:05 编辑

略。。。。

o0star0o · 发表于 2021-11-27 14:04

413191246se 发表于 2021-11-25 01:37
* 楼主有福了！我刚刚重新扩展编辑了此宏，请试用！

谢谢回复，测试可以用，但是你的这个表格的行距不会缩紧，需要手动拉小，请问这个能加一条吗？

413191246se · 发表于 2021-11-27 21:05

* 楼主，你自己将 .Height = xxxxxx(0.9) 这个 0.9 厘米改小即可，如改为 0.5 或 0.6，请试用最新版本：

Sub TableProcess_Update()
'表格处理 -> 光标在表格外处理所有表格；否则当前表格（选定则选区表格）
Dim r As Range, t As Table, c As Cell, i As Paragraph, a As Row, x&, y&, z&, j&, k&, e&, n&
PaperSetup
With ActiveDocument
.Fields.Unlink
.ConvertNumbersToText
.Content.Find.Execute "^l", , , 0, , , , , , "^p", 2
End With
With Selection
If .Type = wdSelectionIP Then
If .Information(wdWithInTable) = True Then
Set t = .Tables(1)
Set r = .Tables(1).Range
Else
Set r = ActiveDocument.Content
End If
Else
Set r = .Range
End If
End With
For Each t In r.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
CommandBars.FindControl(ID:=122).Execute
Selection.ClearFormatting
.MoveEnd 1, -1
With .Font
.Size = 12
.Color = wdColorBlue
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
End With
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
.Next.Delete
'判断表格是否规则(e=1=规则/e=0=不规则)
x = .Information(wdEndOfRangeRowNumber)
y = .Information(wdEndOfRangeColumnNumber)
z = .Cells.Count
End With
If x <> 1 Then
If z = x * y Then
For k = 1 To y
For j = 1 To x - 1
If .Cell(j + 1, k).Width = .Cell(j, k).Width Then e = 1 Else e = 0
If e = 0 Then Exit For
Next j
If e = 0 Then Exit For
Next k
Else
e = 0
End If
Else
e = 1
End If
'删除空段
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
With .Range.Find
.Execute "^w", , , 0, , , , , , "", 2
.Execute "　", , , 0, , , , , , "", 2
End With
End With
If e = 1 Then
'删除序号
If .Cell(1, 1).Range Like "序号*" Then
ActiveDocument.Range(Start:=.Cell(2, 1).Range.Start, End:=.Cell(x, 1).Range.End).Delete
End If
'删除空行
For Each a In .Rows
If Len(Replace(Replace(a.Range.Text, vbCr, ""), Chr(7), "")) = 0 Then a.Delete
Next
'序号自动
If .Cell(1, 1).Range Like "序号*" Then
ActiveDocument.Range(Start:=.Cell(2, 1).Range.Start, End:=.Cell(x, 1).Range.End).Select
n = 0
For Each c In Selection.Cells
n = n + 1
c.Range.Text = n
Next
End If
End If
'边距
.LeftPadding = CentimetersToPoints(0.19)
.RightPadding = CentimetersToPoints(0.19)
.AutoFitBehavior (wdAutoFitContent)
.Select
.AutoFitBehavior (wdAutoFitWindow)
End With
Next
' Selection.HomeKey Unit:=wdStory
End Sub

复制代码

o0star0o · 发表于 2021-11-28 17:32

413191246se 发表于 2021-11-27 21:05
* 楼主，你自己将 .Height = xxxxxx(0.9) 这个 0.9 厘米改小即可，如改为 0.5 或 0.6，请试用最新版本：

谢谢提醒，找到行距位置了，但是这个有个bug，就是如果表格里面有英文内容的话，被把空格给处理没

413191246se · 发表于 2021-11-28 20:41

楼主，你将 4 楼代码中，第 100 - 103 行的代码屏蔽（注释）掉，就可以了，因为我是针对中文表头必须要删除空格的。

xiaoyoufish · 发表于 2021-11-28 22:52

太好了，知道怎么用了

o0star0o · 发表于 2022-1-29 19:00

413191246se 发表于 2021-11-27 21:05
* 楼主，你自己将 .Height = xxxxxx(0.9) 这个 0.9 厘米改小即可，如改为 0.5 或 0.6，请试用最新版本：

你好，你把之前2楼的宏删了呢？我的宏掉了，我刚才运行您最新这个宏无法运行，麻烦请看下呢

413191246se · 发表于 2022-1-30 22:46

楼主，你好！——请将“PaperSetup”这行代码删除或屏蔽（前面打个‘号）均可，意思是“页面设置”为A4纸张。

xseyuan · 发表于 2022-2-18 09:46

表格中，大于一行的段落，左对齐怎么设置？

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

[求助] word调整全文的表格为字体和行距的宏什么写呢？

评分