一些快捷编辑、特殊输入操作的域、宏应用实例代码.doc

本文大部分代码来自于顾经宇其实你还没懂word及其网站或论坛，部分代码经过本人修改，对于方便应用word很有好处。具体应用，请查看原书（右键点击用迅雷下载pdf版本）。发布于此，一为保留自用，二为共享他人。标题中说是“域、宏应用实例代码”，实际上，把一些域的操作也编制成了宏，所以，以下全是宏代码。至于word如何添加宏，不在本文叙述范围，请自行搜索网络。1. 打开文档时光标返回上次关闭时最后编辑处Sub AutoOpen() AutoOpen Macro宏名称一定要是AutoOpen（大小写无所谓） 宏在 2008-4-16 由 * 创建Application.GoBackEnd Sub2. 无格式粘贴Sub 无格式粘贴() 无格式粘贴 Macro 宏在 2006-11-2 由 * 创建Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _ wdInLine, DisplayAsIcon:=FalseEnd Sub3. 匹配目标格式粘贴Sub 匹配目标格式粘贴() 匹配目标格式粘贴 Macro，这个宏的功能与上一个好像是一样的，虽然代码不同，都是匹配目标格式粘贴 宏在 2006-11-3 由 * 创建Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)End Sub4. 删除连续两个换行符Sub 删除连续两个换行符() 删除连续两个换行符 Macro 宏在 2006-11-2 由 * 创建Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find .Text = ll .Replacement.Text = .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.MoveDown Unit:=wdLine, Count:=1End Sub5. 合并连续两个段落标记为一个Sub 替换连续两个段落标记为一个() 替换连续两个段落标记为一个 Macro 宏在 2006-11-2 由 * 创建Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find .Text = pp .Replacement.Text = p .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.MoveDown Unit:=wdLine, Count:=1End Sub6. 替换换行符为段落标记Sub 替换换行符为段落标记()Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find .Text = l .Replacement.Text = p .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.MoveDown Unit:=wdLine, Count:=1End Sub7. 段前空半行Sub 段前空半行() 段前空半行 Macro 宏在 2006-11-3 由 * 创建With Selection.ParagraphFormat.LineUnitBefore = 0.5End WithEnd Sub8. 段前空一行Sub 段前空一行() 段前空一行 Macro 宏在 2006-11-3 由 * 创建With Selection.ParagraphFormat.LineUnitBefore = 1End WithEnd Sub9. 文献标号上标化Sub 文献标号上标化() 参考文献上标化 Macro 宏在 2006-11-3 由 * 创建 Selection.HomeKey Unit:=wdStory Selection.Find.Replacement.ClearFormatting With Selection.Find.Replacement.Font .Superscript = True End With With Selection.Find .Text = -，0-9,- .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Replacement.ClearFormatting With Selection.Find.Replacement.Font .Superscript = True End With With Selection.Find .Text = -，0-9,- .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub10. 箭头上方加文字Sub 箭头上方加文字() 箭头上方加文字 Macro 宏在 2008-4-16 由 * 创建 Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False Selection.TypeBackspace Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:=eq o(sdo2(),sup5(敲击Delete键清除此段文字，改填所需文字，酌情增减箭头长度，最后同时按下shift和F9) Selection.MoveLeft Unit:=wdCharacter, Count:=2 Selection.MoveLeft Unit:=wdWord, Count:=25, Extend:=wdExtend 顾经宇的代码是26，改成25更好End Sub11. 输入分式Sub 分式() 公式 Macro 宏在 2008-4-16 由 * 创建 Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False Selection.TypeBackspace Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:=eq f(分子,分母)End Sub12. 输入平均值Sub 平均值() 平均值 Macro 没有在顾经宇的书和网站中找到这个宏，是本人录制编辑的 宏在 2008-4-17 由 * 创建 Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False Selection.TypeBackspace Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:=eq o( Selection.Font.Italic = wdToggle Selection.TypeText Text:=x Selection.Font.Italic = wdToggle Selection.TypeText Text:=,sdo1( Selection.InsertSymbol Font:=宋体, CharacterNumber:=175, Unicode:=True Selection.TypeText Text:=)End Sub13. 插入无空格的域Sub插入域()word的插入域命令，输入光标前后会有空格，有时候转换成域的结果时，后面的空格也会显示，这个宏会先删除掉空格再让你编辑域代码 宏在 2008-4-17 由 * 录制 Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _ PreserveFormatting:=False Selection.TypeBackspace Selection.Delete Unit:=wdCharacter, Count:=1End Sub-简单分割线-以下5个宏为添加使用参考文献提供方便14. 添加参考文献格式一，参考文献在文档末尾以1 2 3 格式排列Sub 添加参考文献格式一() 添加参考文献 Macro 宏在 2008-4-17 由 * 创建 Selection.Style = ActiveDocument.Styles(尾注引用) Selection.TypeText Text:= Selection.MoveLeft Unit:=wdCharacter, Count:=1 With ActiveDocument.Endnotes .StartingNumber = 1 .NumberStyle = wdNoteNumberStyleArabic End With ActiveDocument.Endnotes.Add Range:=Selection.Range, Reference:= Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Style = ActiveDocument.Styles(默认段落字体) Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:= End Sub15. 添加参考文献格式二，参考文献在文档末尾以1 2 3 格式排列，修改自格式一的代码Sub 添加参考文献格式二() 添加参考文献 Macro 宏在 2008-4-17 由 * 创建 Selection.Style = ActiveDocument.Styles(尾注引用) Selection.TypeText Text:= Selection.MoveLeft Unit:=wdCharacter, Count:=1 With ActiveDocument.Endnotes .StartingNumber = 1 .NumberStyle = wdNoteNumberStyleArabic End With ActiveDocument.Endnotes.Add Range:=Selection.Range, Reference:= Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Style = ActiveDocument.Styles(默认段落字体) Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:= Selection.MoveLeft Unit:=wdCharacter + 2, Count:=1 Selection.TypeText Text:= End Sub16. 返回正文Sub 返回正文()返回正文 Macro宏在 2008-4-16 由 * 创建If ActiveWindow.ActivePane.View.Type = wdPageView Or ActiveWindow. _ ActivePane.View.Type = wdOnlineView Or ActiveWindow.ActivePane.View.Type _ = wdPrintPreview Then ActiveWindow.View.SeekView = wdSeekMainDocument Else ActiveWindow.Panes(2).Close End If Selection.MoveRight Unit:=wdCharacter, Count:=2End Sub17. 再次引用已有参考文献Sub 引用编号()引用编号 Macro宏在 2008-4-16 由 * 创建 Selection.Font.Superscript = wdToggle Selection.TypeText Text:= Selectio