Word宏命令⼤全
1、为宏命令指定快捷键。
在WORD中，操作可以通过菜单项或⼯具栏按钮实现，如果功能项有对应的快捷键的话，利⽤快捷键可以快速实现我们需要的功能。如最常见的CTRL＋O、CTRL＋A等等。WORD已经为很多功能指定了快捷键，可以⼤⼤提⾼WORD的操作速度，⽐⽤⿏标操作快捷很多。
⽽我们⾃⼰编辑或者录制的宏，可以⽤菜单项操作完成，也可以为这些命令设置按钮，通过⼯具栏按钮操作，如果为这些常⽤的宏指定合适的快捷键，会为我们提供很⼤的便利。
如何为功能项设置快捷键或修改功能项已有的快捷键，需要对 WORD进⾏⾃定义设置。
在WORD主界⾯中，点击“⼯具”菜单下的“⾃定义”菜单项，在“⾃定义”对话框中，点击“键盘”，如下图所⽰：
2、举例说明
WORD打开状态下，按ALT＋F11，打开VBA编辑器，粘贴如下代码
Sub 英⽂引号转中⽂双引号()
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """"
.Forward = True
.Wrap = wdStop
.MatchByte = True
End With
With Selection
While .Find.Execute
.
Text = ChrW(8220)
.Find.Execute
.Text = ChrW(8221)
Wend
End With
End Sub
保存后，再打开“⾃定义”等命令可以出现下图：
这时按你要指定的快捷键，⼀⼀般要跟CTRL、ALT和SHIFT结合，可选取⼀个两个或者三个，再加上某⼀个字母。上例我为选定的宏指定的快捷键为ALT+"，因为"与'是在同⼀键上，实际操作是按三个键。如果“⽬前指定到”项为[未指定]，选择是保存常规模板“NORMAL”还是本⽂档，点“指定”，然后关闭。每次按ALT+"，就会执⾏这段VBA命令。
3、指定快捷键，尽量不要使⽤WORD已经使⽤的快捷键，如果⼀定使⽤，那么该快捷键将不再指定给原有的功能命令。指定的快捷键要⽅便记忆，要有⼀定的规律。
4、如果对WORD默认为功能命令指定的快捷键或⾃⼰指定的快捷键不满意，可以进⼊“⾃定义键盘”对话框，在“当前快捷键”列表中，选中要删除的快捷键，此时“删除”按钮被激活，点击“删除”，指定的功能命令的快捷键就被删除了。
也可为符号和样式指定快捷，这⾥不再多说了，下⾯就放⼏段宏命令。如有错误，务必指出。如有侵权，请告知，马上删除。
常规设置下标的过程：输⼊，选定，设定下标，取消选定，设置⾮下标，继续输⼊。下⾯的命令设置光标前⼀个字符为下标，并继续输⼊时保持设置前的格式。后⾯的例⼦不再解释。
Sub Macro1()
'
' Macro1 Macro
' 设置光标前⼀个字符为下标，快捷键为"Alt+="
'
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Subscript = True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Subscript = False
End Sub
Sub Macro9()
Sub Macro9()
'
' Macro9 Macro
' 设置光标前⼀个字符为上标，快捷键为"Alt++"
'
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Superscript = True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Superscript = False
End Sub
Sub Macro2()
'
' Macro2 Macro
' 设置光标前⼀个字符为斜体，快捷键为"Alt+I"
'
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Italic = True
Selection.Font.NameOther = "Times New Roman"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Italic = False
End Sub
Sub Macro5()
'
' Macro5 Macro
' 调整中西⽂字符间距，快捷键为"Alt+J"
'
If Selection.ParagraphFormat.AddSpaceBetweenFarEastAndAlpha = False Then
Selection.ParagraphFormat.AddSpaceBetweenFarEastAndAlpha = True
Else
Selection.ParagraphFormat.AddSpaceBetweenFarEastAndAlpha = False
End If
End Sub
Sub Macro4()
'
' Macro4 Macro
' 设置光标前⼀个⽂字加着重号，快捷键为"Alt+."
'
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.EmphasisMark = wdEmphasisMarkUnderSolidCircle
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.EmphasisMark = wdEmphasisMarkNone
End Sub
Sub Macro10()
'
' Macro10 Macro
' 调整中⽂和数字符间距，快捷键为"Alt+N"
'
If Selection.ParagraphFormat.AddSpaceBetweenFarEastAndDigit = False Then
Selection.ParagraphFormat.AddSpaceBetweenFarEastAndDigit = True
Else
Selection.ParagraphFormat.AddSpaceBetweenFarEastAndDigit = False
End If
End Sub
设置分式的宏命令：A为分⼦，B为分母，输⼊A,B（注意AB之间的逗号为英⽂逗号）。如果分⼦是ABC，分母是DG，输⼊ABC,DG按住SHIFT，按左⽅向键，选定刚才输⼊的字符，留3个不选，执⾏下⾯的命令。
Sub 分式()
'
' 分式 Macro
' 设置选定分数，快捷键为"Alt+F"
'
Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
If Selection.Type = wdSelectionNormal Then
'Selection.Font.Italic = True
Selection.Cut
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="eq \f()"
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Paste
'Selection.TypeText Text:=")"
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=1
Else
MsgBox "您没有选择⽂字。"
End If
'
End Sub
Sub 弧()
'
' 弧 Macro
' 设置选定的两个字母上加弧
Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
If Selection.Type = wdSelectionNormal Then
Selection.Font.Italic = True
Selection.Cut
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="eq \o(\s\up5(⌒"
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Scaling = 150
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Font.Scaling = 100
Selection.TypeText Text:="),\s\do0("
Selection.Paste
Selection.TypeText Text:="))"
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=1
Else
MsgBox "您没有选择⽂字。"
End If
'
input命令End Sub
Sub Password()
'
' ⽂件⾃动添加密码。
'
If ActiveDocument.WriteReserved = False Then
If MsgBox("是否为本⽂档添加密码？", vbYesNo) = vbYes Then With ActiveDocument
.Password = "123456"
.WritePassword = "123456"
End With
Else
End If
Else
End If
End Sub
Sub Example()
'根据⽂档字符数中重复频率排序字符并计数
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU 2008-2-24 18:05:42
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0334^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Dim myDictionary As Object, MyString As String
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Dim myDictionary As Object, MyString As String Dim iCount As Long, i As Long, n As Long
Dim ochar As String, TempA As Variant, st As Single
Dim Array_Keys() As Variant, Array_Items() As Variant
st = VBA.Timer
Set myDictionary = CreateObject("Scripting.Dictionary")
MyString = ActiveDocument.Content.Text
n = Len(MyString) - 1
For i = 1 To n
ochar = VBA.Mid(MyString, i, 1)
If myDictionary.Exists(ochar) = False Then
myDictionary.Add ochar, 1
Else
myDictionary(ochar) = myDictionary(ochar) + 1
End If
Next
MyString = ""
iCount = myDictionary.Count - 1
Array_Keys = myDictionary.keys
Array_Items = myDictionary.Items
Set myDictionary = Nothing
For i = 0 To iCount - 1
For n = i + 1 To iCount
If Array_Items(i) < Array_Items(n) Then
TempA = Array_Items(n)
Array_Items(n) = Array_Items(i)
Array_Items(i) = TempA
TempA = Array_Keys(n)
Array_Keys(n) = Array_Keys(i)
Array_Keys(i) = TempA
End If
Next n
Next i
For i = 0 To iCount
MyString = MyString & Array_Keys(i) & "　" & Array_Items(i) & Chr(13)
Next
ActiveDocument.Content.Text = MyString
MsgBox "共有" & iCount & "个不重复的字符,⽤时" & VBA.Format(Timer - st, "0.00") & "秒"
End Sub
Sub yy()
'本代码旨在解决WORD中数据转化为千分位
'数据限定要求:-922,337,203,685,477.5808 到 922,337,203,685,477.5807
'转化结果1000以上数据以千分位计算,⼩数点右侧保留⼆位⼩数;1000以下数据不变
Dim myRange As Range, i As Byte, myValue As Currency
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕更新
NextFind: Set myRange = ActiveDocument.Content '定义为主⽂档⽂字部分
With myRange.Find '查
.ClearFormatting '清除格式
.Text = "[0-9]{4,15}" '4到15位数据
.MatchWildcards = True '使⽤通配符
Do While .Execute '每次查成功
i = 2 '起始值为2
'如果是有⼩数点
If myRange.Next(wdCharacter, 1) = "." Then
'进⾏⼀个未知循环
While myRange.Next(wdCharacter, i) Like "#"
i = i + 1 '只要是[0-9]任意数字则累加
Wend
'重新定义RANGE对象
myRange.SetRange myRange.Start, myRange.End + i - 1
End If
myValue = VBA.Val(myRange) '保险起见转换为数据，也可省略
myRange = VBA.Format(myValue, "Standard") '转为千分位格式
GoTo NextFind '转到指定⾏
Loop
End With
Application.ScreenUpdating = True '恢复屏幕更新
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
Sub setpicsize_1() '设置图⽚⼤⼩为当前的百分⽐
Dim n '图⽚个数
Dim picwidth
Dim picheight
If Selection.Type = wdSelectionNormal Then
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图⽚
picheight = ActiveDocument.InlineShapes(n).Height
picwidth = ActiveDocument.InlineShapes(n).Width
ActiveDocument.InlineShapes(n).Height = picheight * 0.5 '设置⾼度ActiveDocument.InlineShapes(n).Width = picwidth * 0.5 '设置宽度
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图⽚
picheight = ActiveDocument.Shapes(n).Height
picwidth = ActiveDocument.Shapes(n).Width
ActiveDocument.Shapes(n).Height = picheight * 0.5 '设置⾼度倍数ActiveDocument.Shapes(n).Width = picwidth * 0.5 '设置宽度倍数
Next n
Else End If
End Sub
Sub setpicsize_2() '设置图⽚⼤⼩为固定值
Dim n '图⽚个数
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图⽚ActiveDocument.InlineShapes(n).Height = 400 '设置图⽚⾼度为 400px ActiveDocument.InlineShapes(n).Width = 300 '设置图⽚宽度 300px
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图⽚ActiveDocument.Shapes(n).Height = 400 '设置图⽚⾼度为 400px ActiveDocument.Shapes(n).Width = 300 '设置图⽚宽度 300px
Next n
End Sub
Sub 图⽚版式转换()
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU 2007-12-11 5:28:26
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0281^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'Option Explicit Dim oShape As Variant, shapeType As WdWrapType
On Error Resume Next
If MsgBox("Y将图⽚由嵌⼊式转为浮动式,N将图⽚由浮动式转为嵌⼊式", 68) = 6 Then shapeType = Val(InputBox(Prompt:="请输⼊图⽚版式:0=四周型,1=紧密型, " & vbLf & _ "3=衬于⽂字下⽅,4=浮于⽂字上⽅", Default:=0))
For Each oShape In ActiveDocument.InlineShapes
Set oShape = oShape.ConvertToShape
With oShape
Select Case shapeType
Case 0, 1
.WrapFormat.Type = shapeType
Case 3
.WrapFormat.Type = 3
.ZOrder 5
Case 4
.WrapFormat.Type = 3
.ZOrder 4
Case Else
Exit Sub
End Select
.WrapFormat.AllowOverlap = False '不允许重叠
End With
Next
Else
For Each oShape In ActiveDocument.Shapes
oShape.ConvertToInlineShape

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。