Word宏代碼集錦

1、Word宏代碼集錦Word宏代碼集錦一、       修改word格式：1、' 智能清除選區(qū)軟回車(chē)（換行符）2、' 清除選區(qū)多余空段3、' 合并選區(qū)中“，”結(jié)束的多余分段4、' 清除選區(qū)單字節(jié)空格5、' 清除選區(qū)單字節(jié)空格6、' 清除選區(qū)1字空格7、' 清除選區(qū)段首2字空格8、' 清除選區(qū)Tab9、' 增加選區(qū)空格10、' 選區(qū)段首縮進(jìn)0字11、&

2、#39; 選區(qū)段首縮進(jìn):2字12、' 選區(qū)段首縮進(jìn)轉(zhuǎn)空格已完美13、' 選區(qū)段后間距1行14、' 選區(qū)段后間距1行15、' 選區(qū)段后間距1行16、' 清除選區(qū)圖片17、' 選區(qū)硬回車(chē)轉(zhuǎn)軟回車(chē)18、' 清除選區(qū)軟回車(chē)19' 合并選區(qū)段落20、' 選區(qū)空格轉(zhuǎn)硬回車(chē)21、' 選區(qū)標(biāo)點(diǎn)半角轉(zhuǎn)全角22、' 選區(qū)標(biāo)點(diǎn)全角轉(zhuǎn)半角23、' 選區(qū)中文句號(hào)轉(zhuǎn)半角24、把文檔第一段設(shè)置為標(biāo)題1

3、的格式25、選中的文本橫向居中26、縮小字距27、增大字距28、縮小行距29、增大行距30、等高變寬31、等高變窄32、字表間距33、縱向16開(kāi)34、插入頁(yè)碼35、小寫(xiě)金額轉(zhuǎn)大寫(xiě)金額二、       其它1.調(diào)整圖片大小2.轉(zhuǎn)字體3.轉(zhuǎn)文件格式4、文件加密5、字符替換6、替換引號(hào)7、打印為PDF格式文件8、朗讀文本9. 文獻(xiàn)標(biāo)號(hào)上標(biāo)化10. 箭頭上方加文字11 添加參考文獻(xiàn)格式一，參考文獻(xiàn)在文檔末尾以1 2 3 格式排列12. 添加參考文獻(xiàn)格式二，參考文獻(xiàn)

4、在文檔末尾以1 2 3 格式排列，修改自格式一的代碼13. 返回正文14. 再次引用已有參考文獻(xiàn)15. 查找被刪參考文獻(xiàn)遺留引用，16、統(tǒng)計(jì)修訂的字?jǐn)?shù)17、快速提取腳注內(nèi)容18、從任意頁(yè)面編排頁(yè)碼19、批量實(shí)現(xiàn)縮放打印20、對(duì)文檔內(nèi)容進(jìn)行順序排列21、替換Word文檔插圖的超鏈接22、為文檔的每頁(yè)添加固定內(nèi)容23、批量實(shí)現(xiàn)圖片的等比例縮一、    修改word格式：1、' 智能清除選區(qū)軟回車(chē)（換行符）Sub 智能清除選區(qū)軟回車(chē)()     

5、;   With Selection.Find        .Text = "?l"        .Replacement.Text = "&p"        .Forward = True       &

6、#160;.Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchByte = False &

7、#160;      .MatchAllWordForms = False        .MatchSoundsLike = False        .MatchWildcards = True    End With    Selection.Find.Execute Replace:=wdR

8、eplaceAll       With Selection.Find        .Text = "1l"        .Replacement.Text = "&p"    End With    Selection.Find.Exe

9、cute Replace:=wdReplaceAll       With Selection.Find        .Text = "l"        .Replacement.Text = ""    End With    Selectio

10、n.Find.Execute Replace:=wdReplaceAll   End Sub 2、' 清除選區(qū)多余空段Sub 清除選區(qū)多余空段()    With Selection.Find        .Text = "pp"        .Replacement.Text = "p"

11、;        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "ppp&q

12、uot;        .Replacement.Text = "p"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       Wi

13、th Selection.Find        .Text = "ppp"        .Replacement.Text = "p"        .MatchWildcards = False    End With    Sele

14、ction.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "pp"        .Replacement.Text = "p"        

15、.MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "pp"       

16、0;.Replacement.Text = "p"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find     

17、60;  .Text = "ppp"        .Replacement.Text = "p"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll 

18、0;     With Selection.Find        .Text = "p "        .Replacement.Text = "p"        .MatchWildcards = False    End

19、 With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "pp"        .Replacement.Text = "p"  

20、60;     .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "pp"  &

21、#160;     .Replacement.Text = "p"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll   End Sub 3、' 合并選區(qū)中“，”結(jié)束的多余分段Su

22、b 合并選區(qū)多余分段()    With Selection.Find        .Text = "，p"        .Replacement.Text = "，"        .MatchWildcards = False   

23、 End With    Selection.Find.Execute Replace:=wdReplaceAll     With Selection.Find        .Text = "、p"        .Replacement.Text = "、"   

24、     .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub  4、' 清除選區(qū)單字節(jié)空格Sub 清除選區(qū)單字節(jié)空格()        With Selection.Find  &

25、#160;     .Text = " "        .Replacement.Text = ""        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdRep

26、laceAll End Sub 5、' 清除選區(qū)單字節(jié)空格Sub 清除選區(qū)2單字節(jié)空格()    With Selection.Find        .Text = "  "        .Replacement.Text = ""    

27、0;   .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAllEnd Sub 6、' 清除選區(qū)1字空格Sub 清除選區(qū)1字空格()    With Selection.Find        .Text = "

28、;"        .Replacement.Text = ""        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub 7、' 清除選區(qū)段首2字空格

29、Sub 清除選區(qū)段首2字空格()       With Selection.Find        .Text = ""        .Replacement.Text = ""        .MatchWildcards = Fals

30、e    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub 8、' 清除選區(qū)TabSub 清除選區(qū)Tab()    With Selection.Find        .Text = vbTab      &#

31、160; .Replacement.Text = ""        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub 9、' 增加選區(qū)空格Sub 增加選區(qū)空格()    With Sel

32、ection.Find        .Text = ""        .Replacement.Text = ""        .MatchWildcards = False    End With    Selection.Find

33、.Execute Replace:=wdReplaceAll   End Sub 10、' 選區(qū)段首縮進(jìn)0字Sub 選區(qū)段首無(wú)縮進(jìn)()With Selection.Find        .Text = ""        .Replacement.Text = ""     &#

34、160;  .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.ParagraphFormat        .LeftIndent = CentimetersToPoints(0) 

35、;       '左縮進(jìn)0字符        .RightIndent = CentimetersToPoints(0)       '右縮進(jìn)0字符        .FirstLineIndent = CentimetersToPoints(0)   &

36、#39;首行縮進(jìn)點(diǎn)0公分        .CharacterUnitLeftIndent = 0                   '左縮進(jìn)單位0字符        .CharacterUnitRightIndent = 0

37、60;                 '右縮進(jìn)單位0字符        .CharacterUnitFirstLineIndent = 0    End With       With Selection.ParagraphFor

38、mat        .LeftIndent = CentimetersToPoints(0)        '左縮進(jìn)1字符        .RightIndent = CentimetersToPoints(0)       '右縮進(jìn)2字符  

39、0;     .FirstLineIndent = CentimetersToPoints(0)   '首行縮進(jìn)點(diǎn)0.35公分        .CharacterUnitLeftIndent = 0                   

40、9;左縮進(jìn)單位0字符        .CharacterUnitRightIndent = 0                  '右縮進(jìn)單位0字符        .CharacterUnitFirstLineIndent = 0 

41、   End With End Sub 11、' 選區(qū)段首縮進(jìn):2字Sub 選區(qū)段首縮進(jìn)2字()    With Selection.ParagraphFormat        .LeftIndent = CentimetersToPoints(0)        '左縮進(jìn)1字符  

42、0;     .RightIndent = CentimetersToPoints(0)       '右縮進(jìn)2字符        .FirstLineIndent = CentimetersToPoints(0.35)   '首行縮進(jìn)點(diǎn)單位公分        .Chara

43、cterUnitLeftIndent = 0                   '左縮進(jìn)單位0字符        .CharacterUnitRightIndent = 0           

44、60;      '右縮進(jìn)單位0字符        .CharacterUnitFirstLineIndent = 2    End With End Sub 12、' 選區(qū)段首縮進(jìn)轉(zhuǎn)空格已完美Sub 選區(qū)段首縮進(jìn)轉(zhuǎn)空格()       Selection.InsertParagraphBef

45、ore     Call 選區(qū)段首無(wú)縮進(jìn)       With Selection.Find        .Text = "p"        .Replacement.Text = "p"      

46、60; .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll    Selection.Delete       With Selection.Find        .Text = "p&quo

47、t;        .Replacement.Text = ""        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll   End Sub 13、' 選區(qū)

48、段后間距1行Sub 選區(qū)段后間距1行()    Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)    Selection.ParagraphFormat.LineUnitAfter = 1  End Sub 14、' 選區(qū)段后間距1行Sub 選區(qū)段前段后間距半行()    Selection.ParagraphFormat.

49、FirstLineIndent = CentimetersToPoints(0)    Selection.ParagraphFormat.LineUnitBefore = 0.5    Selection.ParagraphFormat.LineUnitAfter = 0.5 End Sub 15、' 選區(qū)段后間距1行Sub 選區(qū)段前段后無(wú)間距()       Selection.Paragrap

50、hFormat.FirstLineIndent = CentimetersToPoints(0)    Selection.ParagraphFormat.LineUnitBefore = 0    Selection.ParagraphFormat.LineUnitAfter = 0 End Sub 16、' 清除選區(qū)圖片Sub 清除選區(qū)圖片()       With Selection.Find

51、        .Text = "1"        .Replacement.Text = ""        .MatchWildcards = True    End With    Selection.Find.Execute Re

52、place:=wdReplaceAll   End Sub 17、' 選區(qū)硬回車(chē)轉(zhuǎn)軟回車(chē)Sub 選區(qū)硬回車(chē)轉(zhuǎn)軟回車(chē)()       With Selection.Find        .Text = "p"        .Replacement.Text = "l&q

53、uot;        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll   End Sub 18、' 清除選區(qū)軟回車(chē)Sub 清除選區(qū)軟回車(chē)()'   With Selection.Find  &

54、#160;     .Text = "l"        .Replacement.Text = ""        .MatchWildcards = True    End With    Selection.Find.Execute Replace:=wdRepl

55、aceAll   End Sub 19' 合并選區(qū)段落Sub 合并選區(qū)段落()    With Selection.Find        .Text = ""        .Replacement.Text = ""      

56、  .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll     With Selection.Find        .Text = "p"        

57、;.Replacement.Text = "l"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find     

58、0;  .Text = "l"        .Replacement.Text = ""        .MatchWildcards = True    End With    Selection.Find.Execute Replace:=wdReplaceAll  

59、60;    Selection.Paragraphs.Add    '添加段落符號(hào)    End Sub 20、' 選區(qū)空格轉(zhuǎn)硬回車(chē)Sub 選區(qū)空格轉(zhuǎn)硬回車(chē)()    With Selection.Find        .Text = ""    &

60、#160;   .Replacement.Text = "p"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub 21、' 選區(qū)標(biāo)點(diǎn)半角轉(zhuǎn)全角Sub 選區(qū)標(biāo)點(diǎn)半角轉(zhuǎn)全角()  

61、;  With Selection.Find        .Text = ","        .Replacement.Text = "，"        .MatchWildcards = False    End With  

62、60; Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = ""        .Replacement.Text = "；"      &

63、#160; .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = ":"      

64、  .Replacement.Text = "："        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find    

65、;    .Text = "?"        .Replacement.Text = "？"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll&#

66、160;      With Selection.Find        .Text = "!"        .Replacement.Text = "！"        .MatchWildcards = False   &#

67、160;End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "."        .Replacement.Text = "" 

68、0;      .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "." 

69、60;      .Replacement.Text = "。"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll   End Sub 22、' 選區(qū)標(biāo)點(diǎn)全角轉(zhuǎn)半角

70、60;Sub 選區(qū)標(biāo)點(diǎn)全角轉(zhuǎn)半角()    With Selection.Find        .Text = "，"        .Replacement.Text = ","        .MatchWildcards = False  &

71、#160; End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "；"        .Replacement.Text = ""

72、60;       .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "："&#

73、160;       .Replacement.Text = ":"        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Sel

74、ection.Find        .Text = "？"        .Replacement.Text = "?"        .MatchWildcards = False    End With    Selection.Fi

75、nd.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = "！"        .Replacement.Text = "!"        .MatchWil

76、dcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find        .Text = ""        .Replacem

77、ent.Text = "."        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.Find       &#

78、160;.Text = "。"        .Replacement.Text = "."        .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll   End S

79、ub 23、' 選區(qū)中文句號(hào)轉(zhuǎn)半角Sub 選區(qū)中文句號(hào)轉(zhuǎn)半角()    With Selection.Find        .Text = "。"        .Replacement.Text = "."        .MatchWi

80、ldcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll End Sub 24、把文檔第一段設(shè)置為標(biāo)題1的格式Sub 標(biāo)題1()    ActiveDocument.Paragraphs(1).Style = ActiveDocument.Styles("標(biāo)題 1")    Selec

81、tion.ParagraphFormat.Alignment = wdAlignParagraphCenter End Sub 25、選中的文本橫向居中Sub 橫向居中()With Selection.Find        .Text = ""        .Replacement.Text = ""     &#

82、160;  .MatchWildcards = False    End With    Selection.Find.Execute Replace:=wdReplaceAll       With Selection.ParagraphFormat        .LeftIndent = CentimetersToPoints(0) 

83、;       '左縮進(jìn)0字符        .RightIndent = CentimetersToPoints(0)       '右縮進(jìn)0字符        .FirstLineIndent = CentimetersToPoints(0)   &

84、#39;首行縮進(jìn)點(diǎn)0公分        .CharacterUnitLeftIndent = 0                   '左縮進(jìn)單位0字符        .CharacterUnitRightIndent = 0

85、60;                 '右縮進(jìn)單位0字符        .CharacterUnitFirstLineIndent = 0    End With       With Selection.ParagraphFor

86、mat        .LeftIndent = CentimetersToPoints(0)        '左縮進(jìn)1字符        .RightIndent = CentimetersToPoints(0)       '右縮進(jìn)2字符  

87、0;     .FirstLineIndent = CentimetersToPoints(0)   '首行縮進(jìn)點(diǎn)0.35公分        .CharacterUnitLeftIndent = 0                   

88、9;左縮進(jìn)單位0字符        .CharacterUnitRightIndent = 0                  '右縮進(jìn)單位0字符        .CharacterUnitFirstLineIndent = 0 

89、   End With    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter End Sub 26、縮小字距Sub 縮小字距()    Dim b    On Error Resume Next    ActiveDocument.Compatibility(wdSpacingInWholePoints)

90、 = False        '不按點(diǎn)陣縮放字距    If Selection.Font.Spacing = 9999999 Then     '當(dāng)字距不等時(shí),此值為9999999        For b = 1 To Selection.Characters.Count '得到所選字符總數(shù)  &#

91、160;         Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 '為每個(gè)字符更改字距        Next b    Else        Selection.Font.S

92、pacing = Selection.Font.Spacing - 0.1    End IfEnd Sub  27、增大字距Sub 增大字距()    On Error Resume Next    ActiveDocument.Compatibility(wdSpacingInWholePoints) = False        '不按點(diǎn)陣縮放字距

93、60;   Dim b    If Selection.Font.Spacing = 9999999 Then     '當(dāng)字距不等時(shí),此值為9999999        For b = 1 To Selection.Characters.Count '得到所選字符總數(shù)         

94、60;  Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 '為每個(gè)字符更改字距        Next b    Else        Selection.Font.Spacing = Selection.Font.Spacing + 0.1 

95、   End IfEnd Sub 28、縮小行距Sub 縮小行距()    Dim b    On Error Resume Next    StatusBar = "老劉鄭重提示: 該命令會(huì)取消行自動(dòng)對(duì)齊到行網(wǎng)格！"    With Selection.ParagraphFormat      .

96、AutoAdjustRightIndent = False          '不自動(dòng)調(diào)整右縮進(jìn)      .DisableLineHeightGrid = True           '不自動(dòng)對(duì)齊行網(wǎng)格    End With   

97、0;If Selection.ParagraphFormat.LineSpacing = 9999999 Then        For b = 1 To Selection.Paragraphs.Count            Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95

98、0;       Next b    Else        Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95    End IfEnd Sub 29、增大行距Sub 增大行距()    D

99、im b    On Error Resume Next    StatusBar = "老劉鄭重提示: 該命令會(huì)取消行自動(dòng)對(duì)齊到行網(wǎng)格！"    With Selection.ParagraphFormat      .AutoAdjustRightIndent = False         &

100、#160;'不自動(dòng)調(diào)整右縮進(jìn)      .DisableLineHeightGrid = True           '不自動(dòng)對(duì)齊行網(wǎng)格    End With    If Selection.ParagraphFormat.LineSpacing = 9999999 Then   '當(dāng)段落間

101、距不等時(shí),此值為9999999        For b = 1 To Selection.Paragraphs.Count               '得到所選段落總數(shù)            Selection.Paragraphs(b)

102、.LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05        Next b    Else        Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05    End I

103、fEnd Sub 30、等高變寬Sub 等高變寬()    On Error Resume Next    Selection.Font.Scaling = Selection.Font.Scaling + 1End Sub 31、等高變窄Sub 等高變窄()    On Error Resume Next    Selection.Font.Scaling = Selection.Font.Sc

104、aling - 1End Sub 32、字表間距Sub 字表間距()    On Error Resume Next    ActiveDocument.Compatibility(wdAlignTablesRowByRow) = False    Selection.Tables(1).Select    With Selection.Borders(wdBorderTop)   &#

105、160;    .LineStyle = wdLineStyleSingle        .LineWidth = wdLineWidth150pt        .Color = Options.DefaultBorderColor    End With    With Selection.Borders(wdB

106、orderLeft)        .LineStyle = wdLineStyleSingle        .LineWidth = wdLineWidth150pt        .Color = Options.DefaultBorderColor    End With   &#

107、160;With Selection.Borders(wdBorderBottom)        .LineStyle = wdLineStyleSingle        .LineWidth = wdLineWidth150pt        .Color = Options.DefaultBorderColor   &#

108、160;End With    With Selection.Borders(wdBorderRight)        .LineStyle = wdLineStyleSingle        .LineWidth = wdLineWidth150pt        .Color = Options.Default

109、BorderColor    End With    On Error GoTo a:    Selection.Tables(1).Rows.Alignment = wdAlignRowCenter    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter    Selection.Rows.SpaceBetweenColu

110、mns = 0    Selection.Tables(1).AllowAutoFit = Falsea:    If Err = 4605 Then       MsgBox "當(dāng)前位置不在表格中,請(qǐng)重新定義。", vbInformation, "劉厚彬現(xiàn)在輕輕地告訴你"    End IfEnd Sub 33、縱向16開(kāi)Sub 縱向16開(kāi)()&

111、#39; With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _    Content.End).PageSetup              '插入點(diǎn)之后'With ActiveDocument.PageSetup        &

112、#39;整篇文檔With Selection.PageSetup              '本節(jié)    .Orientation = wdOrientPortrait     '縱向    .TopMargin = MillimetersToPoints(24)    .

113、BottomMargin = MillimetersToPoints(25)    .LeftMargin = MillimetersToPoints(28)    .RightMargin = MillimetersToPoints(25)    .FooterDistance = MillimetersToPoints(21)    .PageWidth = MillimetersToPoints(196)    .PageHeight = MillimetersToPoints(270)    .FirstPageTray = wdPrinterDefaultBin    .OtherPagesTray = wdPrinterDefaultB