第1页 / 共78页
第2页 / 共78页
第3页 / 共78页
第4页 / 共78页
第5页 / 共78页
第6页 / 共78页
第7页 / 共78页
第8页 / 共78页
Word 宏命令大全2.doc
'锁 F8
'锁 F8
'锁 F8
'锁 F8
'锁 F0
'锁 F8
'锁 F8
'锁 F5/保存
F8 常数命令集
'F8 文字
'F8 资料分类
'锁 F8
'锁 F8
'锁 F8
'锁 F8
'锁 F8
'锁 F8
'F8 文字/保存
'保存/F8 移动图表
F8 批处理类型
F8 考试科目
F8 最下级命令
Public excelRows As Integer
Public myDoc As Object
Public wordApp As Object
Public excelApp As Object
Public mySheet As Object
Public xlBook As Object
Public defaultPath As String
Public excelPath As String
Public isAsk As Boolean
Public myCurCommand As String
Public myCommand As String
Public myReCommand As String
Public myConst As String
Public isClose As Boolean
Public myNewName As String
Public isReName As Boolean
Public isKillFile As Boolean
Public myClass As String
Public extensionName As String 'F8 扩展名
Public myAllName() As String
Public keyWord As String
Public myCount As Integer
Public isReColor As Boolean
'
Public strtext As String
' '定义一个文件搜索对象
Public s As FileSearch
Public myStr As String
'公共
Public myCurStr As String '公共(最底层、参数)
'公共(最底层、常量)
Public myText As String
Public myBool As Boolean
'公共
Public myInt As Integer
Public myPath As String
Public myRange As Range
Public myName As String
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem
As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As
Long
Sub F2 无格式粘贴到新 word 并保存关闭() '
'F8 图片名称
'F8 关键字
'F6/F7/F9/F8 图片
'F6
'公共
'公共
'公共
'公共
' 用法（不选择→F2）：（没有窗口打开，新建文档） + 无格式粘贴 + 清除考试大等相关信
息 + 格式/字体/段落调整 + 保存 + 关闭
' 用法（ 全选 →F2）：区别在于，有窗口打开也新建
Dim isUnSave As Boolean
myCommand = "F2"
If Application.Documents.Count > 0 Then
Then
文档
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End
Documents.Add DocumentType:=wdNewBlankDocument
'如果全选，新建
End If
If ActiveDocument.Paragraphs.Count > 2 Then
Documents.Add DocumentType:=wdNewBlankDocument
' 新 建 文 档
Documents.Add DocumentType:=wdNewBlankDocument
'新建文档
Link:=False, DataType:=wdPasteText,
'无格式粘贴
Placement:=wdInLine,
'
网速过的去，就不新建
End If
Else
End If
Selection.PasteSpecial
DisplayAsIcon:=False
F10 调整
F0 字体段落
F0 保存
End Sub
Sub F3 无格式粘贴程序()
'
' 用法（不选择→F3）：（没有窗口打开，新建文档） + 无格式粘贴 + 清除考试大等相关信
息 + 格式/字体/段落调整 + 保存
' 用法（ 全选 →F3）：区别在于，会先关闭并删除原来 word；区别于 F2，不关闭
myCommand = "F3"
If Application.Documents.Count < 1 Then
Documents.Add DocumentType:=wdNewBlankDocument
'新建文档
'
System.Reflection.Missing.Value,System.Reflection.Missing.Value, Boolean isVisible)
用模板新建文档
oWordApplic.Documents.Add(strName,
'
Else
ActiveDocument.Activate
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End
And Selection.Range.End <> 0 Then
myName = ActiveDocument.FullName
ActiveDocument.Save
ActiveDocument.Close
Kill myName
Documents.Add DocumentType:=wdNewBlankDocument
关闭 + 删除 + 新建文档
End If
End If
Selection.PasteSpecial
DisplayAsIcon:=False
Link:=False, DataType:=wdPasteText,
'无格式粘贴
'如果全选，保存
Placement:=wdInLine,
F10 调整
F0 字体段落
Selection.WholeStory
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
F0 保存
' 文章结尾换行
End Sub
Sub F4 带图表粘贴到新 word 并保存关闭()
'
' 用法（不选择→F4）：（没有窗口打开，新建文档） + 粘贴 + 清除考试大等相关信息 + 格
式/字体/段落调整 + 保存 + 关闭
' 用法（ 全选 →F4）：区别在于，有窗口打开也新建。
myCommand = "F4"
If Application.Documents.Count > 0 Then
Then
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End
Documents.Add DocumentType:=wdNewBlankDocument
'如果全选，新建
文档
'
Else
End If
If ActiveDocument.Paragraphs.Count > 2 Then
Documents.Add DocumentType:=wdNewBlankDocument
End If
Documents.Add DocumentType:=wdNewBlankDocument
'新建文档
'新建文档
End If
Selection.PasteAndFormat (wdPasteDefault)
F10 调整
F0 字体段落
F0 保存
'粘贴
End Sub
Sub F5 格式调整程序()
'
' 用法（不选择→F5）：格式/字体/段落调整 + 保存
' 用法（ 全选 →F5）：区别在于，保存下划线、加粗等格式。
' 用法（没有窗口打开时）：新建文档 + 粘贴 + 保存 + 关闭。没有处理格式。
Dim issaveformat As Boolean
myCommand = "F5"
If Application.Documents.Count > 0 Then
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End
If InStr(ActiveDocument.Range.Text, " 0 Then F7 加答案
F7 加答案
issaveformat = True
'如果全选，保存下划线、加粗等格式
End If
'去格式标记
Then
Else
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.WholeStory
isClose = True
'新建文档
'粘贴
End If
F10 调整
F0 字体段落
If issaveformat Then F7 加答案
F0 保存
End Sub
Sub F6 编号()
'
' 用法（不选择→F6）：自动编号。可以设置 firstValue（第 1 题编号，默认为 1）与 mycount
（每套试题的数量，默认为 0，即不作限制）
' 用法（ 全选 →F6）：只改颜色。
Dim firstValue As Integer
firstValue = 1
myCount = 0
'设置初始值 firstValue（第一题编号），默认为 1
'设置初始值 mycount（每套试题数量），默认为 0（不作限制）
isReColor = False:
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End Then
myBool = True
'如果全选
Selection.WholeStory
isReColor = True
'改颜色
myBool = False
Else
myStr = "初始值=" + CStr(firstValue) + Chr(13) + Chr(13)
myStr = myStr + "每套试题数量=" + CStr(myCount) + "（0 即不作限制）" + Chr(13)
myStr = InputBox(myStr, "提示", "初始值=" + CStr(firstValue) + "；每套试题数量=" +
If myStr = "" Then Exit Sub
firstValue = Mid(myStr, InStr(myStr, "初始值=") + 4, InStr(myStr, "每套试题数量=") -
CStr(myCount))
InStr(myStr, "初始值=") - 5)
myCount = Mid(myStr, InStr(myStr, "每套试题数量=") + 7)
myInt = firstValue
End If
End If
If Selection.Range.Start = Selection.Range.End Then
Selection.WholeStory
If myBool Then
Do
With Selection.Find
'##############################################################################
###########
" + CStr(myInt) + "．"
([0-9]{1,})．"
.Text = "
.Replacement.Text = "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchFuzzy = False
.MatchWildcards = True
'特殊项
'特殊项
End With
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
.Collapse Direction:=wdCollapseStart
End If
If Not .Find.Execute Then Exit Do
End With
If myCount = 0 Then
myInt = myInt + 1
Else
myInt = myInt + 1
If myInt >= firstValue + myCount Then
myInt = firstValue
End If
End If
Loop
End If
'##############################################################################
###########
If isReColor Then
'纯文本
ActiveDocument.Range.Font.Color = wdColorBlack
isReColor = False
For myInt = 1 To ActiveDocument.Paragraphs.Count
If isReColor Then
Set myRange = ActiveDocument.Paragraphs(myInt).Range
myRange.Select
With myRange.Find
[0-9]{1,})．"
.Text = "(
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchFuzzy = False
.MatchWildcards = True
If .Execute Then isReColor = False
.Text = "
If .Execute Then isReColor = False
'特殊项
'特殊项
[一二三四五六七八九十]{1,}、"
'包含标题->去色
'包含标题->去色
End With
Else
If InStr(ActiveDocument.Paragraphs(myInt).Range.Text, "【") > 0 Then
myStr = ActiveDocument.Paragraphs(myInt).Range.Text
If InStr(myStr, "【 答 案】") > 0 Or InStr(myStr, "【 解 析】") > 0 Or
InStr(myStr, "【来源】") > 0 Or InStr(myStr, "【评注】") > 0 Then
isReColor = True
isReColor Then ActiveDocument.Paragraphs(myInt).Range.Font.Color =
End If
End If
End If
If
wdColorBlue
Next myInt
isReColor = False
End If
Exit Sub
'##############################################################################
###########
With Selection.Find
]{1,}"
.Text = "^13[^13
.Replacement.Text = "^p
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "
.Text = "(^13
.Text = "(
.Text = "(
[0-9]{1,}．"
[■□△0-9]{1,}[．.、])"
[0-9]{1,}[）、．.][!^13]{1,50}^13)"
[!^13：】]{1,20}[：:】])"
'不空行
'加色
'
'
'
.Replacement.Text = "^p^&"
.Text = "
.Text = "(
[一二三四五六七八九十]{1,}、"
[ （第总首其]{1,}[一二三四五六七八九十之先次参考疑问题答前结
束]{1,}[章节条种类、：，）语言文献答案][!^13]{1,35}^13)"
'小标题空行
'大标题空行
'不空行
.Replacement.Font.Color = wdColorBlack
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Replacement.Text = "^p^&"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
If Selection.Find.Found Then
With Selection.Find
.Text = "^13^13
1．"
.Replacement.Text = "^p
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
1．"
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
End If
End Sub
Sub F7 加答案()
'
' 用法（不选择→F7）：加答案。先试题后答案；题号连续（"
' 用法（ 全选 →F7）：格式转换（加粗/斜体/下划线/居中/右对齐/红色/蓝色/上下标）。
' 用法（ 置首 →F7）：答案格式。
21．"形式），从 1 开始。
Dim isReText As Boolean, isReFormat As Boolean
isReText = False: isReFormat = False: myBool = True
myInt = 1
'初始值，设置第 1 题的编号
If Selection.Range.Start <> Selection.Range.End Then
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End
'如果全选
Then
Selection.WholeStory
isReFormat = True
myBool = False
'保存格式
isReText = True
myBool = False
'答案清理
Else
End If
Else
If Selection.Range.Start = 0 Then
'答案清理
isReText = True
myBool = False
End If
Selection.WholeStory
End If
Selection.Find.ClearFormatting
If isReText Then
With Selection.Find
[0-9A-z]{1,3})([!、.．0-9A-z])"
.Text = "(
.Replacement.Text = "\1．\2"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "([0-9A-z]{1,3})[、.]"
.Replacement.Text = "\1．"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "([0-9]{1,})([A-Z√×])"
.Replacement.Text = "\1．\2"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "([0-9]{1,})．"
.Replacement.Text = "^p
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
^&"
'选项加点
'选项换点
'选项加点："
12A 13B"
'答案换行："XX
13．B"
Selection.Find.Replacement.ClearFormatting
'##############################################################################
###########
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "【答案】([A-Za-z]{1,})[，、； ]([A-Za-z])"
.Replacement.Text = "【答案】\1\2"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(【答案[】A-Z]{1,})a"
.Replacement.Text = "\1A"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
'答案简化
'答案简化
'答案简化
'答案简化
'答案简化
'答案简化
'答案大写
'答案大写
'答案大写
'答案大写
'答案大写
'选项换点
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(【答案[】A-Z]{1,})b"
.Replacement.Text = "\1B"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(【答案[】A-Z]{1,})c"
.Replacement.Text = "\1C"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(【答案[】A-Z]{1,})d"
.Replacement.Text = "\1D"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(【答案[】A-Z]{1,})e"
.Replacement.Text = "\1E"
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "([0-9]{1,3})．"
.Replacement.Text = "^p
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
\1．"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
]{3,}"
.Text = "^13[^13
.Replacement.Text = "^p
.Wrap = wdFindContinue
.MatchByte = True
.MatchWildcards = True
"
End With
Selection.Find.Execute Replace:=wdReplaceAl
Exit Sub
End If
If myBool Then
'##############################################################################
###########
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
'（x1,y1）与（x2,y2）
相关推荐
2023年江西萍乡中考道德与法治真题及答案.doc
2012年重庆南川中考生物真题及答案.doc
2013年江西师范大学地理学综合及文艺理论基础考研真题.doc
2020年四川甘孜小升初语文真题及答案I卷.doc
2020年注册岩土工程师专业基础考试真题及答案.doc
2023-2024学年福建省厦门市九年级上学期数学月考试题及答案.doc
2021-2022学年辽宁省沈阳市大东区九年级上学期语文期末试题及答案.doc
2022-2023学年北京东城区初三第一学期物理期末试卷及答案.doc
2018上半年江西教师资格初中地理学科知识与教学能力真题及答案.doc
2012年河北国家公务员申论考试真题及答案-省级.doc
2020-2021学年江苏省扬州市江都区邵樊片九年级上学期数学第一次质量检测试题及答案.doc
2022下半年黑龙江教师资格证中学综合素质真题及答案.doc
