word中几个好用的宏代码(立方米上标、关闭样式自动更新、删除无效样式、表格加粗边框、宋体引号)

时间:2021-10-13 19:26:20
  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:以上有些是网上别人的,有的是我自己录制的,具体记不清了。如有冒犯,请通知我删除!