word自动化排版宏

怀英慕者

自己制作的word自动化排版宏，水平低，很粗糙！还有一些功能未实现，希望高手多多指点，把里面一些多余的代码删减掉，另外再添加一些功能！例如怎样能循环判断最后一页如果只有不到三分之一页的几行时，通过减小行距和字号从而去除最后一页。再者就是大家比较认可的正规排版格式（字号、行距等等）是什么？我想通过做这个东西，我们能有效地提高工作效率，又无需借助其他软件。下面将全部代码奉上！

1. Sub 格式设置()
   
2. '
   
3. ' 格式设置 Macro
   
4. ' 宏在 2008-9-23 由 陈凯 制作
   
5. '
   
6.     Application.ScreenUpdating = False
   
7.     '更改所有硬回车为软回车
   
8.     Selection.Find.ClearFormatting
   
9.     Selection.Find.Replacement.ClearFormatting
   
10.     With Selection.Find
    
11.         .Text = "^l"
    
12.         .Replacement.Text = "^p"
    
13.         .Forward = True
    
14.         .Wrap = wdFindContinue
    
15.         .Format = False
    
16.         .MatchCase = False
    
17.         .MatchWholeWord = False
    
18.         .MatchByte = True
    
19.         .MatchWildcards = False
    
20.         .MatchSoundsLike = False
    
21.         .MatchAllWordForms = False
    
22.     End With
    
23.     Selection.Find.Execute Replace:=wdReplaceAll
    
24.     '去除所有空行
    
25.     Dim i As Paragraph, n As Integer
    
26.     Application.ScreenUpdating = False
    
27.     For Each i In ActiveDocument.Paragraphs
    
28.     If Len(i.Range) = 1 Then
    
29.     i.Range.Delete
    
30.     n = n + 1
    
31.     End If
    
32.     Next
    
33.     Application.ScreenUpdating = True
    
34.     '去除半角空格
    
35.     Selection.Find.ClearFormatting
    
36.     Selection.Find.Replacement.ClearFormatting
    
37.     With Selection.Find
    
38.         .Text = " "
    
39.         .Replacement.Text = ""
    
40.         .Forward = True
    
41.         .Wrap = wdFindContinue
    
42.         .Format = False
    
43.         .MatchCase = False
    
44.         .MatchWholeWord = False
    
45.         .MatchByte = True
    
46.         .MatchWildcards = False
    
47.         .MatchSoundsLike = False
    
48.         .MatchAllWordForms = False
    
49.     End With
    
50.     Selection.Find.Execute Replace:=wdReplaceAll
    
51.     '去除全角空格
    
52.     Selection.Find.ClearFormatting
    
53.     Selection.Find.Replacement.ClearFormatting
    
54.     With Selection.Find
    
55.         .Text = "　"
    
56.         .Replacement.Text = ""
    
57.         .Forward = True
    
58.         .Wrap = wdFindContinue
    
59.         .Format = False
    
60.         .MatchCase = False
    
61.         .MatchWholeWord = False
    
62.         .MatchByte = True
    
63.         .MatchWildcards = False
    
64.         .MatchSoundsLike = False
    
65.         .MatchAllWordForms = False
    
66.     End With
    
67.     Selection.Find.Execute Replace:=wdReplaceAll
    
68.     '替换非标准引号为标准引号
    
69.     Selection.Find.ClearFormatting
    
70.     Selection.Find.Replacement.ClearFormatting
    
71.     With Selection.Find
    
72.         .Text = """(*)"""
    
73.         .Replacement.Text = ChrW(8220) & "\1" & ChrW(8221)
    
74.         .Forward = True
    
75.         .Wrap = wdFindContinue
    
76.         .Format = False
    
77.         .MatchCase = False
    
78.         .MatchWholeWord = False
    
79.         .MatchByte = False
    
80.         .MatchAllWordForms = False
    
81.         .MatchSoundsLike = False
    
82.         .MatchWildcards = True
    
83.     End With
    
84.     Selection.Find.Execute Replace:=wdReplaceAll
    
85.     '字母数字符号全角转半角 Macro
    
86.     Dim qjsz, bjsz As String, iii As Integer '定义qjsz(全角数字)、bjsz(半角数字)为字符串型，iii为整数型
    
87.         qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,./<>?;’:[]{}\|=-+_)(*%$#@!`~&"
    
88.         bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，。／《》？；'：【】｛｝＼｜＝－＋＿）（×％＄＃＠！'～＆"
    
89.         Selection.WholeStory
    
90.     For iii = 1 To 95 '循环10次
    
91.     With Selection.Find
    
92.        .Text = Mid(qjsz, iii, 1) 'mid函数：返回文本字符串中从指定位置开始的特定数目的字符，每次取一个数字
    
93.        .Replacement.Text = Mid(bjsz, iii, 1) '将用于替换的相应位置的半角数字
    
94.        .Format = False '保留替换前的字符格式
    
95.        .MatchWildcards = False
    
96.        .Execute Replace:=wdReplaceAll '用半角符号替换全角符号
    
97.     End With
    
98.     Next iii
    
99.     '修改小数点错误
    
100.     Selection.Find.ClearFormatting
     
101.     Selection.Find.Replacement.ClearFormatting
     
102.     With Selection.Find
     
103.         .Text = "([0-9])。([0-9])"
     
104.         .Replacement.Text = "\1.\2"
     
105.         .Forward = True
     
106.         .Wrap = wdFindContinue
     
107.         .Format = False
     
108.         .MatchCase = False
     
109.         .MatchWholeWord = False
     
110.         .MatchByte = False
     
111.         .MatchAllWordForms = False
     
112.         .MatchSoundsLike = False
     
113.         .MatchWildcards = True
     
114.     End With
     
115.     Selection.Find.Execute Replace:=wdReplaceAll
     
116.     '设置字号
     
117.     Selection.WholeStory  '全选
     
118.     Selection.ClearFormatting  '清除全文格式
     
119.     Selection.Font.Size = 14  '设置字号为14号
     
120.     '设置行距
     
121.     Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
     
122.     Selection.ParagraphFormat.LineSpacing = 25
     
123.     Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify  '设置文本为两端对齐
     
124.     Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2  '设置段首缩进2字符
     
125.     Selection.HomeKey Unit:=wdStory  '移至文首
     
126.     Selection.EndKey Unit:=wdLine, Extend:=wdExtend  '选中首行
     
127.     Selection.ClearFormatting  '清除首行格式
     
128.     Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter  '设置首行居中对齐
     
129.     Selection.ParagraphFormat.LineUnitBefore = 1  '设置首行段前间距1行
     
130.     Selection.ParagraphFormat.LineUnitAfter = 1  '设置首行段后间距1行
     
131.     Selection.Font.Name = "微软雅黑"  '设置首行字体为“微软雅黑”
     
132.     Selection.Font.Size = 18  '设置首行字号为18号
     
133.     Selection.Font.Bold = wdToggle  '设置首行字形为加粗
     
134.     Application.ScreenUpdating = True
     
135. End Sub

复制代码

[ 本帖最后由 怀英慕者 于 2009-1-12 15:30 编辑 ]

welcome520

不错呀，学习了

XUZHANCHENG

学习一下，能演示一下用法吗？

怀英慕者

这还要演示一下用法吗？在word里面打开VB编辑器，把代码复制过去，然后在工具栏自定义一个按钮，使这个按钮调用这个宏就可以了，很简单啊！

yb010

学习！学习！

youliqi

不错，但并非所有文章的排版都是一样的

szqhb

收藏了，慢慢学习

yongzhang26

好东西，学习一下

xinlin00

如果要选定第二段或第二行，怎么改代码？？谢谢请教中

Selection.HomeKey Unit:=wdStory  '移至文首
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend  '选中首行
    Selection.ClearFormatting  '清除首行格式
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter  '设置首行居中对齐
    Selection.ParagraphFormat.LineUnitBefore = 1  '设置首行段前间距1行
    Selection.ParagraphFormat.LineUnitAfter = 1  '设置首行段后间距1行
    Selection.Font.Name = "微软雅黑"  '设置首行字体为“微软雅黑”
    Selection.Font.Size = 18  '设置首行字号为18号
    Selection.Font.Bold = wdToggle  '设置首行字形为加粗

mengshu

呵呵，这个高难度啊，楼主水平太高了，俺就慢慢学习吧