word中幾個好用的宏代碼（立方米上標、關閉樣式自動更新、刪除無效樣式、表格加粗邊框、宋體引號）

  1 Sub 替換立方米()
  2     With Selection.Find
  3         .Text = "m3"
  4         .Replacement.Text = "mm3"
  5         .Forward = True
  6         .Wrap = wdFindContinue
  7         .Format = True
  8         .MatchCase = False
  9         .MatchWholeWord = False
 10         .MatchByte = False
 11         .MatchWildcards = False
 12         .MatchSoundsLike = False
 13         .MatchAllWordForms = False
 14     End With
 15     Selection.Find.Execute Replace:=wdReplaceAll
 16     With Selection.Find.Replacement.Font
 17         .Superscript = True
 18         .Subscript = False
 19     End With
 20     With Selection.Find
 21         .Text = "m3"
 22         .Replacement.Text = "3"
 23         .Forward = True
 24         .Wrap = wdFindContinue
 25         .Format = True
 26         .MatchCase = False
 27         .MatchWholeWord = False
 28         .MatchByte = False
 29         .MatchWildcards = False
 30         .MatchSoundsLike = False
 31         .MatchAllWordForms = False
 32     End With
 33     Selection.Find.Execute Replace:=wdReplaceAll
 34 End Sub
 35 
 36 '關閉樣式自動更新
 37 Sub CloseAutoUpdates()
 38     Dim update As Style
 39     Set Updates = ActiveDocument.Styles
 40     For Each update In Updates
 41         If update.Type = wdStyleTypeParagraph Then
 42             update.AutomaticallyUpdate = False
 43         End If
 44     Next
 45 End Sub
 46 
 47 Sub 刪除無效樣式()
 48     For Each objStyle In ActiveDocument.Styles
 49     On Error Resume Next
 50         If objStyle.BuiltIn = False And objStyle.InUse = True Then
 51              objStyle.Delete 
 52         End If
 53     Next
 54 End Sub
 55 Sub 表格加粗邊框()
 56 '
 57 ' 表格加粗邊框 宏
 58 ' 設置表格加粗邊框
 59 '
 60     With Selection.Tables(1)
 61         With .Borders(wdBorderLeft)
 62             .LineStyle = wdLineStyleSingle
 63             .LineWidth = wdLineWidth150pt
 64             .Color = wdColorAutomatic
 65         End With
 66         With .Borders(wdBorderRight)
 67             .LineStyle = wdLineStyleSingle
 68             .LineWidth = wdLineWidth150pt
 69             .Color = wdColorAutomatic
 70         End With
 71         With .Borders(wdBorderTop)
 72             .LineStyle = wdLineStyleSingle
 73             .LineWidth = wdLineWidth150pt
 74             .Color = wdColorAutomatic
 75         End With
 76         With .Borders(wdBorderBottom)
 77             .LineStyle = wdLineStyleSingle
 78             .LineWidth = wdLineWidth150pt
 79             .Color = wdColorAutomatic
 80         End With
 81         With .Borders(wdBorderHorizontal)
 82             .LineStyle = wdLineStyleSingle
 83             .LineWidth = wdLineWidth075pt
 84             .Color = wdColorAutomatic
 85         End With
 86         With .Borders(wdBorderVertical)
 87             .LineStyle = wdLineStyleSingle
 88             .LineWidth = wdLineWidth075pt
 89             .Color = wdColorAutomatic
 90         End With
 91         .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
 92         .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
 93         .Borders.Shadow = False
 94     End With
 95     With Options
 96         .DefaultBorderLineStyle = wdLineStyleSingle
 97         .DefaultBorderLineWidth = wdLineWidth150pt
 98         .DefaultBorderColor = wdColorAutomatic
 99     End With
100 End Sub
101 Sub 宋體引號()
102 '
103 ' 宋體引號 宏
104 ' 把全部引號改成宋體
105 '
106     Selection.Find.ClearFormatting
107     Selection.Find.Replacement.ClearFormatting
108     With Selection.Find
109         .Text = "[" & ChrW(8220) & ChrW(8221) & "]"
110         .Replacement.Text = ""
111         .Forward = True
112         .Wrap = wdFindContinue
113         .Format = True
114         .MatchCase = False
115         .MatchWholeWord = False
116         .MatchByte = False
117         .MatchAllWordForms = False
118         .MatchSoundsLike = False
119         .MatchWildcards = True
120         .Replacement.Font.Name = "宋體"
121     End With
122     Selection.Find.Execute Replace:=wdReplaceAll
123 End Sub

使用時打開word，按alt+f11，粘貼上去，要用哪一個就把鼠標點到哪一個sub裏，而後f5，搞定！

PS：以上有些是網上別人的，有的是我本身錄製的，具體記不清了。若有冒犯，請通知我刪除！