表格内容距离边距设置的vba

413191246se · 发表于 2018-4-1 02:09

* 楼主，针对你提供的新附件，请试用下面的宏：（请备份后使用并核对！）

Sub aaaa财会账表_循环遍历所有表格及单元格()
'功能：光标在表格中处理当前表格；否则处理所有表格！
Dim t As Table, i As Long, c As Cell, r As Range, e&, j&, k&, x&, y&, z&
If Selection.Information(wdWithInTable) = True Then i = 1
For Each t In ActiveDocument.Tables
If i = 1 Then Set t = Selection.Tables(1)
With t
With .Range
'表头上方标题颜色----此段代码可以删除/注释掉！
With .Previous.Paragraphs(1).Range.Font
.Size = 14
.Bold = True
.Color = wdColorGreen '绿色
End With
'表头上方标题颜色----此段代码可以删除/注释掉！
For Each c In .Cells
Set r = c.Range
With r
If r Like "*[一-﨩]*" Then
.Font.Color = wdColorPink '粉红
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.ParagraphFormat.CharacterUnitLeftIndent = 0.5
If r Like "*减[：:]*" Then
.Select
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
.InsertBefore Text:=Chr(-24159)
With .ParagraphFormat
.Alignment = wdAlignParagraphJustify
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
End With
End If
Else
.Font.Color = wdColorBlue '蓝色
.ParagraphFormat.Alignment = wdAlignParagraphRight
.ParagraphFormat.CharacterUnitRightIndent = 0.5
End If
End With
Next
'判断表格是否规则
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
If e = 1 Then '规则表格
'首行加粗
With .Rows(1).Range
With .Font
.Name = "黑体"
.Bold = True
.Color = wdColorRed '红色
End With
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitLeftIndent = 0
.LeftIndent = CentimetersToPoints(0)
End With
.HighlightColorIndex = wdYellow '突出显示/黄色
'计提比例/居中
.Select
With Selection
.Find.ClearFormatting
.Find.Execute "计提比例*", , , 1, , , 1
.SelectColumn
.ParagraphFormat.Alignment = wdAlignParagraphCenter
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitRightIndent = 0
.RightIndent = CentimetersToPoints(0)
End With
End With
End With
'末行加粗
With .Rows(.Rows.Count).Range
With .Font
.NameFarEast = "黑体"
.NameAscii = "宋体"
.Bold = True
.Color = wdColorRed '红色
End With
With .Cells(1).Range
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitLeftIndent = 0
.LeftIndent = CentimetersToPoints(0)
End With
End With
.HighlightColorIndex = wdYellow '突出显示/黄色
'例外
.Select
For Each c In Selection.Cells
If Asc(c.Range) = -24150 Then
With c.Range.ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitRightIndent = 0
.RightIndent = CentimetersToPoints(0)
End With
End If
Next
End With
Else '不规则表格
For Each c In .Range.Cells
Set r = c.Range
If r Like "*项*目*" Or r Like "期末数*" Or r Like "年初数*" Or r Like "账面余额*" Or r Like "金额*" Or r Like "比例*" Or r Like "坏账准备*" Or r Like "*合*计*" Then
With c.Range
With .Font
.Name = "黑体"
.Bold = True
.Color = wdColorRed '红色
End With
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.CharacterUnitLeftIndent = 0
.LeftIndent = CentimetersToPoints(0)
End With
.HighlightColorIndex = wdYellow '突出显示/黄色
End With
End If
Next
'查找合计
For Each c In .Range.Cells
If c.Range Like "*合*计*" Then
c.Range.Select
Exit For
End If
Next
With Selection
Do While .Next(4, 1).Information(12)
.Next(4, 1).Select
With .Font
.Color = wdColorRed '红色
.Bold = True
End With
.Range.HighlightColorIndex = wdYellow '突出显示/黄色
Loop
End With
End If
End With
If i = 1 Then Exit For
Next
'外框加粗----此功能不喜欢可以删除/注释掉！（比较费墨）
For Each t In ActiveDocument.Tables
For j = 1 To 4
t.Range.Borders(-j).LineWidth = 12
Next
Next
'外框加粗----此功能不喜欢可以删除/注释掉！（比较费墨）
Selection.HomeKey unit:=wdStory
MsgBox "处理完毕！！！！！！！！！！！！" & vbCr & vbCr & _
"*** 如果想打印，只须<全选>，再点击<突出显示：无>即可！" & vbCr & _
"*** 如果想打印，只须<全选>，再点击<自动色>即可！" & vbCr & _
"*** 注释语句可以删除，或注释掉！", vbOKOnly + vbExclamation
End Sub

复制代码

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

[求助] 表格内容距离边距设置的vba