附件（宏）2019-8-22 最新——请各位朋友自行更新！

413191246se · 发表于 2019-8-23 00:02

* 功能：自动将落款后的附件名称复制到落款前并设置符合公文要求的格式，无需人工校对（建议看两眼）。
* 亮点：通过在每个附件名称前插入制表符实现自动对齐，再也无需手动调整。
* 更新：请打开 Word2003/2007，按 Alt + F8 组合键，打开宏名列表，找到“附件”宏，点击右侧“删除”按钮，在回答询问时点“是”，删除附件宏。然后点击“编辑”按钮，进入 VBE 中，按 Ctrl + End 将光标移至代码区最下面，将最新《附件》宏代码复制粘贴于此，然后，关闭代码区窗口，再关闭 Word，重新进入后就可以使用了。

Sub 附件()
'更新/2019-8-22/定稿
Dim s As Range, r As Range, i As Paragraph, j&, k&, n&, t$
With Selection
If .Type = wdSelectionIP Then Exit Sub Else Set s = .Range
.EndKey 5
With .Find
.ClearFormatting
.Text = "[^13^12]附件*^13"
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
If Asc(.Text) = 13 Then
.Characters(1).InsertAfter Text:=Chr(12)
.MoveStart 1, 2
Else
.MoveStart
End If
.MoveEnd 1, -1
If .Previous.Previous.Previous.Information(12) Then .Previous.Previous.Delete
n = n + 1
.Text = "附件" & n
With .Font
.NameFarEast = "黑体"
.NameAscii = "Times New Roman"
.Bold = True
.Color = wdColorRed
End With
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
End With
.Next(4, 1).Select
If Not (.Next.Information(12)) Then
If Not (.Next(4, 1) Like "*[。：:_ ]*" Or .Next(4, 1) Like "[一1][、.．]*" Or .Next(4, 1) Like "（[一1]）*" Or .Next(4, 1) Like "第一*") Then
.MoveEnd 4, 1
.Paragraphs(1).Range.Characters.Last.Delete
End If
End If
If Not (.Next.Information(12)) Then
If Not (.Next(4, 1) Like "*[。：:_ ]*" Or .Next(4, 1) Like "[一1][、.．]*" Or .Next(4, 1) Like "（[一1]）*" Or .Next(4, 1) Like "第一*") Then
.MoveEnd 4, 1
.Paragraphs(1).Range.Characters.Last.Delete
End If
End If
.MoveEnd 1, -1
.Text = Replace(.Text, " ", "")
.Text = Replace(.Text, "　", "")
.Text = Replace(.Text, vbTab, "")
.Text = Replace(.Text, ChrW(160), "")
.MoveEnd
t = t & .Text
With .Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.Size = 20
.Bold = True
.Color = wdColorAutomatic
End With
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
.Alignment = wdAlignParagraphCenter
End With
If .Range.ComputeStatistics(1) > 1 Then
If Len(.Text) < 31 Then 缩成一行
End If
If .Text Like "*[）”]?" Then .InsertBefore Text:=" "
.InsertParagraphBefore
.Characters.Last.InsertBefore Text:=vbCr
.EndKey 5
k = 1
End With
Loop
End With
If k = 0 Then Exit Sub
If n = 1 Then .Previous(4, 1).Previous(4, 1).Previous(4, 1).Characters.Last.Previous.Delete
'''
s.Select
.HomeKey 6, 1
With .Find
.ClearFormatting
.Text = "^13附件"
.Forward = True
.MatchWildcards = True
.Execute
If .Found = True Then
With .Parent
.MoveStart
Do
.MoveDown 4, 1, 1
Loop Until .Text Like "*" & vbCr & vbCr
.MoveEnd 1, -1
.Next.Delete
Set r = .Range
End With
Else
Set r = s.Previous(4, 1).Previous.Previous.Previous
End If
End With
With r
.Text = vbCr & t & vbCr
With .Font
.Size = s.Font.Size
.Bold = False
.Color = wdColorViolet
End With
.MoveStart
.MoveEnd 1, -1
With .Paragraphs(1).Range.ParagraphFormat
.CharacterUnitLeftIndent = 3.05
.CharacterUnitFirstLineIndent = -4.62
End With
If n > 1 Then
.MoveStart 4, 1
For Each i In .Paragraphs
With i.Range.ParagraphFormat
.CharacterUnitLeftIndent = 7.7
.CharacterUnitFirstLineIndent = -1.56
End With
Next
.MoveStart 4, -1
End If
For Each i In .Paragraphs
j = j + 1
If n = 1 Then
i.Range.InsertBefore Text:=vbTab
Else
i.Range.InsertBefore Text:=j & "．" & vbTab
End If
Next
.InsertBefore Text:="附件："
If n = 1 Then .ParagraphFormat.CharacterUnitFirstLineIndent = -3.1
For Each i In .Paragraphs
With i.Range
If .ComputeStatistics(1) > 1 Then
.Characters.Last.Select
With Selection
.MoveStart 5, -1
If Len(.Text) = 2 Then
.MoveStart 5, -1
If .Text Like "*．*" Then
ActiveDocument.Range(Start:=.Characters(InStr(.Text, vbTab) + 2).Start, End:=.Characters.Last.End).Select
Else
If n = 1 Then
.MoveStart 1, 5
Else
.MoveStart
End If
End If
.Font.Spacing = -0.4
End If
End With
End If
End With
Next
End With
End With
'''
If n = 1 Then
With Selection
.Expand 4
.MoveStart 1, 5
.Font.Spacing = -0.4
End With
End If
End Sub

复制代码

专搞excel · 发表于 2019-8-23 08:54

楼主上传个附件例子吧，不是很清楚表达的意思

413191246se · 发表于 2019-8-23 09:08

楼上朋友，谢谢关注！不清楚附件宏有什么用途，说明平时不进行公文排版吧？经常进行公文排版的朋友，会需要此宏的。附件我就不上了。再次感谢关注！

413191246se · 发表于 2019-8-23 09:59

谢谢楼上朋友关注！不懂什么意思，说明平时未公文排版过吧！等你哪天需要公文排版了，就明白了。

413191246se · 发表于 2019-8-31 20:45

顶。。。。

praijna · 发表于 2019-9-1 09:32

感恩老师的分享！祝福周末快乐！

413191246se · 发表于 2019-9-6 23:10

谢谢 praijna 朋友！

413191246se · 发表于 2019-9-14 00:49

略。。。。

ldl--- · 发表于 2019-9-17 11:41

老师的公文排版附件格式似乎不对，附件距正文一个空行，多附件附件号对齐，附件名第二行对齐齐线墨点。

413191246se · 发表于 2019-9-17 19:38

ldl--- 朋友，你更新了本帖的最新代码了吗？请再试试，或提供附件，谢谢！

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

[分享] 附件（宏）2019-8-22 最新——请各位朋友自行更新！