word中几个好用的宏代码（立方米上标、关闭样式自动更新、删除无效样式、表格加粗边框、宋体引号）
Posted on 2013-12-21 16:08 而且 阅读(4502) 评论(0) 编辑 收藏 举报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：以上有些是网上别人的，有的是我自己录制的，具体记不清了。如有冒犯，请通知我删除！
