优化整理文档代码

chenwenming · 发表于 2019-8-9 13:47

413191246se 发表于 2019-8-9 09:56
请参见：http://club.excelhome.net/thread-1487647-1-1.html

学习了，谢谢！第一章还行，但是自定义没用得起来；附件是我一直要做的排版，原文是没排之前的，要求用代码达到效果文档，您是否试一下？

413191246se · 发表于 2019-8-10 09:50

* 楼主，你的空白通用模板已经被篡改了！建议在 C 盘查找 Normal.dotm（打开高级搜索选项），找到几个删除几个，然后打开 Word，再退出重进。
* 拼凑了一些代码，由于行数过多，请楼主在运行时耐心等待（没完全按照楼主设想的格式，见谅！）。

Sub aaab个性排版()
With ActiveDocument
.CopyStylesFromTemplate Template:=.AttachedTemplate.FullName
.Fields.Unlink
.ConvertNumbersToText
.Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
.Select
With Selection
.Range.HighlightColorIndex = wdNoHighlight
.ClearFormatting
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
End With
''''
Dim t As Table
For Each t In .Tables
With t.Range.Rows
.WrapAroundText = False
.Alignment = wdAlignRowCenter
End With
Next
'''
.Content.Find.Execute "([0-9]@)、", , , 1, , , , , , "\1．", 2
'''
Dim i As Paragraph, n&
Const s As String = "一二三四五六七八九十1234567890百零〇○"
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
n = 1
If .Text Like "（*" Then n = 2
Do While InStr(s, .Characters(n)) > 0
n = n + 1
If .Characters(n).Text = "、" Then .Style = wdStyleHeading2: Exit Do
If .Characters(n).Text = "．" Then .Style = wdStyleHeading3: Exit Do
Loop
If .Text Like "[ABCDE]、*" Then .Style = wdStyleHeading4
'
n = 1
If .Text Like "第*" Then n = 2
Do While InStr(s, .Characters(n)) > 0
n = n + 1
If .Characters(n).Text = "章" Then .Style = wdStyleHeading1: Exit Do
Loop
End If
End With
Next
'''
'Title2345Font
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
If .Style = "正文" Then
.Font.Size = 14
.ParagraphFormat.CharacterUnitFirstLineIndent = 9.25
ElseIf .Style = "标题 1" Then
.Font.NameFarEast = "华文中宋"
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
End With
.InsertBreak Type:=0
ElseIf .Style = "标题 2" Then
.Font.NameFarEast = "黑体"
.ParagraphFormat.CharacterUnitFirstLineIndent = 3
ElseIf .Style = "标题 3" Then
.Font.NameFarEast = "华文中宋"
.Font.NameAscii = "Times New Roman"
.ParagraphFormat.CharacterUnitFirstLineIndent = 5
ElseIf .Style = "标题 4" Then
.Font.NameAscii = "Times New Roman"
.ParagraphFormat.CharacterUnitFirstLineIndent = 7.5
End If
If .Text Like "B、*" Then .ParagraphFormat.CharacterUnitFirstLineIndent = 9.21
End If
End With
Next
'''
'Title2345Color----字体颜色----可以删除！
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
If .Style = "正文" Then
.Font.Color = wdColorBlue
ElseIf .Style = "标题 2" Then
.Font.Color = wdColorRed
ElseIf .Style = "标题 3" Then
.Font.Color = wdColorPink
ElseIf .Style = "标题 4" Then
.Font.Color = wdColorGreen
End If
End If
End With
Next
'''
With .Content
With .Find
.Execute "(第[一二三四五六七八九十]@章)([! 　^s^t])*", , , 1, , , , , , "\1　\2", 2
.Execute "(^13[ABCDE])、", , , 1, , , , , , "\1．", 2
End With
With .Font
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacing = LinesToPoints(1.5)
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
.KeepWithNext = False
.KeepTogether = False
End With
End With
'''标题4绿色/可以删除
For Each i In .Paragraphs
With i.Range
If Not .Information(12) Then
If .Style = "标题 4" Then .Font.Color = wdColorGreen
End If
End With
Next
'''
For Each t In .Tables
With t.Range
.Font.Size = 12
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.ParagraphFormat.Space1
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
With .Rows
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(0.9)
End With
.Next(4, 1).ParagraphFormat.SpaceBefore = 6
End With
Next
.Paragraphs(1).Range.Delete
End With
''''删除页眉横线
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'''
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
Selection.HomeKey 6
MsgBox "处理完毕！！！！！！！！！！！", 0 + 48
End Sub

复制代码

chenwenming · 发表于 2019-8-12 10:08

413191246se 发表于 2019-8-10 09:50
* 楼主，你的空白通用模板已经被篡改了！建议在 C 盘查找 Normal.dotm（打开高级搜索选项），找到几个删除 ...

谢谢，我研究研究

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

[求助] 优化整理文档代码

浏览过的版块