word自动化排版宏

[分享]word自动化排版宏[复制链接]自己制作的word自动化排版宏，水平低，很粗糙！还有一些功能未实现，希望高手多多指点，把里面一些多余的代码删减掉，另外再添加一些功能！例如怎样能循环判断最后一页如果只有不到三分之一页的几行时，通过减小行距和字号从而去除最后一页。再者就是大家比较认可的正规排版格式（字号、行距等等）是什么？我想通过做这个东西，我们能有效地提高工作效率，又无需借助其他软件。下面将全部代码奉上！Sub格式设置()''格式设置Macro'宏在2008-9-23由陈凯制作'Application.ScreenUpdating=False'更改所有硬回车为软回车Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=^l.Replacement.Text=^p.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'去除所有空行DimiAsParagraph,nAsIntegerApplication.ScreenUpdating=FalseForEachiInActiveDocument.ParagraphsIfLen(i.Range)=1Theni.Range.Deleten=n+1EndIfNextApplication.ScreenUpdating=True'去除半角空格Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=.Replacement.Text=.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'去除全角空格Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=.Replacement.Text=.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'替换非标准引号为标准引号Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=(*).Replacement.Text=ChrW(8220)&\1&ChrW(8221).Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=False.MatchAllWordForms=False.MatchSoundsLike=False.MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'字母数字符号全角转半角MacroDimqjsz,bjszAsString,iiiAsInteger'定义qjsz(全角数字)、bjsz(半角数字)为字符串型，iii为整数型qjsz=０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,./?;’:[]{}\|=-+_)(*%$#@!`~&bjsz=0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，。／《》？；'：【】｛｝＼｜＝－＋＿）（×％＄＃＠！'～＆Selection.WholeStoryForiii=1To95'循环10次WithSelection.Find.Text=Mid(qjsz,iii,1)'mid函数：返回文本字符串中从指定位置开始的特定数目的字符，每次取一个数字.Replacement.Text=Mid(bjsz,iii,1)'将用于替换的相应位置的半角数字.Format=False'保留替换前的字符格式.MatchWildcards=False.ExecuteReplace:=wdReplaceAll'用半角符号替换全角符号EndWithNextiii'修改小数点错误Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=([0-9])。([0-9]).Replacement.Text=\1.\2.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=False.MatchAllWordForms=False.MatchSoundsLike=False.MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'设置字号Selection.WholeStory'全选Selection.ClearFormatting'清除全文格式Selection.Font.Size=14'设置字号为14号'设置行距Selection.ParagraphFormat.LineSpacingRule=wdLineSpaceExactlySelection.ParagraphFormat.LineSpacing=25Selection.ParagraphFormat.Alignment=wdAlignParagraphJustify'设置文本为两端对齐Selection.ParagraphFormat.CharacterUnitFirstLineIndent=2'设置段首缩进2字符Selection.HomeKeyUnit:=wdStory'移至文首Selection.EndKeyUnit:=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'设置首行字形为加粗Application.ScreenUpdating=TrueEndSub普通浏览复制代码保存代码打印代码Sub格式设置()''格式设置Macro'宏在2008-9-23由陈凯制作'Application.ScreenUpdating=False'更改所有硬回车为软回车Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=^l.Replacement.Text=^p.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'去除所有空行DimiAsParagraph,nAsIntegerApplication.ScreenUpdating=FalseForEachiInActiveDocument.ParagraphsIfLen(i.Range)=1Theni.Range.Deleten=n+1EndIfNextApplication.ScreenUpdating=True'去除半角空格Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=.Replacement.Text=.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'去除全角空格Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=.Replacement.Text=.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAll'替换非标准引号为标准引号Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text=(*).Replacement.Text=ChrW(8220)&\1&ChrW(8221).Forward=True.Wrap=wdFindContinue.Format=False.MatchCa