导图社区 积累系统-vba
- 153
- 13
- 4
- 举报
积累系统-vba
这是一篇关于积累系统-vba的思维导图，主要内容有使用说明、公共代码、Excel.Application、Word.Application等。
编辑于2022-09-05 06:43:36 北京市- VBA
- 积累系统
- 相似推荐
- 大纲
代码总结
使用说明
思维导图配合vba代码积累文件一起用，把思维导图中的代码复制到代码区进行运行，在实践中复习相关知识。
熟悉公共代码：字符串、数组、日期和时间、文件操作
字符串掌握：长度、定位、截取、去空、符号等操作
数组掌握：生成、加缀
日期和时间掌握：格式、生成
文件操作掌握：判断、生成、改名、复制、删除
掌握excel基础概念：application工程，workbook工作薄，worksheet工作表，range区域，selection选中的区域，cell单元格区域，cells单元格集，sheets工作表集，activesheet当前工作表;
掌握word基础概念：application工程，document word文档，range区域，selection选中的区域，Paragraphs段落
语句模型掌握：选择、循环和递归
选择项超过3个就用select case endselect
知道集合或数组时用foreach循环
知道循环次数时用for循环
while wend可以改为if endif，相当于只循环一次
递归有待研究，似乎可以相当于if以及逆向思维
公共代码
sub 研究文件操作()
MsgBox Dir(文件路径, vbDirectory) = "" '即可判断文件也可以是文件夹存在否，true则没有，false则有
文件路径 = ThisWorkbook.Path & "\测试文件\"
MsgBox Dir(文件全名, vbDirectory) = "" '即可判断文件也可以是文件夹存在否，true则没有，false则有
文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件1.docx" '同级文件夹里的文件
MkDir 文件路径 '只能创建文件夹，前提是没有，否则报错
Name 文件全名 As 文件路径 & "测试文件2.docx" '给文件或文件夹重命名,前提是存在，否则报错
FileCopy 文件路径 & "测试文件2.docx", 文件全名 '只能复制文件,前提是存在，否则报错，文件夹用文件系统
'Kill 文件路径 & "测试文件2.docx"'只能删除文件,前提是存在，否则报错
'RmDir 文件路径 '删除文件夹，前提是存在并且为空文件夹，否则报错
更改默认目录或文件夹。 ChDir
更改默认驱动器。 ChDrive
返回当前路径。 CurDir
返回文件日期/时间戳。 FileDateTime
返回文件、目录、标签属性。 GetAttr
返回文件长度。 FileLen
设置文件的属性信息。 SetAttr
Sub 研究字符串()
'MsgBox Format(字符串1, ">") '字母转成大写,用起来比较方便
字符串1 = " abca "
字符串2 = "ACD"
'MsgBox Format(字符串2, "<") '字母转成小写
'MsgBox StrConv(字符串1, 1) '字母转成大写
'MsgBox StrConv(字符串2, 2) '字母转成小写
'MsgBox StrConv(字符串1, 3) '字母转成首字母大写
'MsgBox UCase(字符串1) '字母转成大写
'MsgBox LCase(字符串2) '字母转成小写
'MsgBox Format(Now, "yy-mm-dd-hh-mm-ss") ' 返回 "2022-04-30-10-45-03"。
'MsgBox Format(5, "0。00%") ' 返回 "500.00%"。
'MsgBox String(5, "*") ' 返回 "*****"。只可以重复一个字母
'MsgBox Space(10) '返回10个空格
'MsgBox Str(23) '返回 "23"把数字变成字符串
'MsgBox Int("23") '返回 "23"把字符串变成整数
'MsgBox Format(23) '返回 "23"把数字变成字符串
'MsgBox Len(字符串1) '返回字符串的长度
'MsgBox InStr(字符串1, "a") '从左边开始第一个出现a的位置
'MsgBox InStrRev(字符串1, "a") '从右边开始第一个出现a的位置
'MsgBox Left(字符串1, 1) '从左边开始长度为1的子字符串
'MsgBox Right(字符串1, 1) '从右边开始长度为1的子字符串
'MsgBox Mid(字符串1, 2, 1) '从左边位置2开始长度为1的子字符串
'MsgBox LTrim(字符串1) '左边空格全部去除
'MsgBox RTrim(字符串1) '右边空格全部去除
'MsgBox Trim(字符串1) '两头空格全部去除
'MsgBox Chr(13) '回车符
'MsgBox Chr(10) '换行符，表面上同chr(13)
'MsgBox Chr(66) '返回B，66对应字符为B
'MsgBox Asc("A") '返回65，A对应字符值为65
Sub 研究数组()
序列 = Array(1, "2") '创建数组
MsgBox 序列(0) '1
'序列 = 序号数组(10) '返回 1,2,3,4,5,6,7,8,9,10
Function 序号数组(个数) '带参数的函数
ReDim 列表(个数 - 1)
For i = 0 To 个数 - 1
列表(i) = i + 1
Next
序号数组 = 列表
'MsgBox 序列(0) '1'MsgBox 序列(9) '10'MsgBox LBound(序列)'0'MsgBox UBound(序列) '9
'重复序列 = 重复数组(1, 10) '返回 1,1,1,1,1,1,1,1,1,1
Function 重复数组(重复词, 次数) '先准备参数，再调用函数
ReDim 列表(次数 - 1)
For i = 0 To 次数 - 1
列表(i) = 重复词
Next
重复数组 = 列表
'MsgBox 重复序列(0) '1'MsgBox 重复序列(9) '1'MsgBox LBound(序列)'0'MsgBox UBound(序列) '9
'重复序列 = 重复数组2(1, 2, 5) '返回 1,2,1,2,1,2,1,2,1,2
Function 重复数组2(重复词1, 重复词2, 次数) '先准备参数，再调用函数
ReDim 列表(次数 * 2)
For i = 0 To 次数 - 1
列表(i * 2) = 重复词1
列表(i * 2 + 1) = 重复词2
Next
重复数组2 = 列表
'MsgBox 重复序列(1) '2
'字符串序列 = Split(字符串)
'字符串 = "一 二 三 四 五 六 七 八 九"
'MsgBox 字符串序列(0) '一'MsgBox 字符串序列(8) '九'MsgBox LBound(序列) '0'MsgBox UBound(字符串序列) '8
'字符串序列 = Split(字符串, "*")
'字符串 = "一*二*三" '用*号作为间隔符
'MsgBox 字符串序列(0) '一
'字符串序列 = 数组加前缀和后缀(字符串序列, Chr(13), "．")'每个元素前面加回车后面加点
Function 数组加前缀和后缀(数组, 前缀, 后缀)
For i = 0 To UBound(数组)
数组(i) = 前缀 & 数组(i) & 后缀
Next
数组加前缀和后缀 = 数组
'MsgBox 字符串序列(0) '
ReDim 数列(n) '数组数列元素个数可以根据n变化,n为2，元素个数为3个，0，1，2
n = 2
'MsgBox 数列(2) '没有赋值时是空
'MsgBox UBound(数列) '最大的索引，一般是元素个数-1
'MsgBox LBound(数列) '最小的索引，一般是0，不常用
MsgBox IsArray(n) '判断是不是数列
Sub 研究时间及日期()
'MsgBox Date + 1 '年/月/日，+1相当于明天日期
MsgBox Format(Date, "yy-mm-dd") ' 日期格式化 返回 "22-04-26"。
'MsgBox Year(Date)
'MsgBox Month(Date)
'MsgBox Day(Date)
'MsgBox Weekday(Date) '周二=3 周日=1，周六=7
'MsgBox 周几(Date)'调用周几函数
Function 周几(日期) '带参数的函数
星期 = Split(" 日 一 二 三 四 五 六")
周几 = "周" & 星期(Weekday(日期))
'MsgBox DateSerial(1984, 4, 14) '返回"1984/4/14"比较方便定义时间变量初始化
'MsgBox DateValue("1984 4 14") '返回"1984/4/14"
'MsgBox #4/14/1984# '返回"1984/4/14"
'MsgBox Time'时：分：秒
'MsgBox Hour(Time)
'MsgBox Minute(Time)
'MsgBox Second(Time)
'MsgBox TimeSerial(1, 4, 14) '返回"1:04:14"比较方便定义时间变量初始化
'MsgBox TimeValue("1: 4: 14") '返回"1:04:14"
'MsgBox #1:04:14 PM# '返回"1:04:14"不好控制
'MsgBox Now '相当于 date & time
MsgBox Format(Now, "yy-mm-dd-hh-mm-ss") ' 日期和时间格式化 返回 "22-04-26-22-22-22"。
Excel.Application
Sub 研究Application()
Application.DisplayAlerts = False '不跳出警告对话框
Application.DisplayAlerts = True '可以跳出警告对话框
Sub 研究run()
'Application.Run "输出信息", "成功" '调用sub
Sub 输出信息(信息)
MsgBox 信息
MsgBox Application.Run("重复信息", "成功") '调用function
Function 重复信息(信息)
重复信息 = 信息 & 信息
Sub 研究FileDialog()
Set 对话框 = Application.FileDialog(msoFileDialogFolderPicker) '对话框有4种，msoFileDialogFolderPicker是文件夹
对话框.InitialFileName = ThisWorkbook.Path '初始路径
'对话框.Title = "你妈妈" '对话框标题
MsgBox 对话框.Show '对话框按钮值，按确定（-1），按取消（0）
MsgBox 对话框.SelectedItems(1) '对话框选中的文件夹
Sub 研究Worksheet()
'Sheets.Add'创建新表单
'Set 工作表 = ActiveSheet '创建对象
'Set 工作表 = Sheets(ActiveSheet.Name) '创建对象,注意Sheets(单元格)不行，改为Sheets(单元格.text)
'Set 工作表 = Sheets(1) '创建对象
'MsgBox 工作表.Name '测试代码是否成功
'工作表.Select '激活工作表
'工作表.Copy 工作表 '复制工作表并放在工作表前面
'工作表.Copy , 工作表 '复制工作表并放在工作表后面
MsgBox 工作表存在否("汇总")
Function 工作表存在否(工作表名)
工作表存在否 = 0
For Each 工作表 In Sheets
If 工作表.Name = 工作表名 Then
工作表存在否 = 1
Exit For '跳出for循环
End If
Next
MsgBox 修改表名直到不重("汇总")
Function 修改表名直到不重(工作表名) 'while wend 可以改为if endif只运行一次
i = 1
名字 = 工作表名
While 工作表存在否(名字) = 1
名字 = 工作表名 & "-" & i
i = i + 1
Wend
修改表名直到不重 = 名字
MsgBox 修改表名直到不重递归("新建项目", 0)
Function 修改表名直到不重递归(工作表名, i)
If 工作表存在否(工作表名) = 0 And i = 0 Then
修改表名直到不重递归 = 工作表名
ElseIf 工作表存在否(工作表名 & "-" & i) = 0 And i > 0 Then
修改表名直到不重递归 = 工作表名 & "-" & i
Else
修改表名直到不重递归 = 修改表名直到不重递归(工作表名, i + 1)
End If
Sub 研究Shapes()
ActiveSheet.Shapes(1).Select 'shapes可以是按钮
Selection.Characters.Text = ActiveSheet.Name '修改按钮的内容
Sub 研究range()
'Set 区域 = Cells '全部区域
'Set 区域 = Selection '创建区域对象
'Set 区域 = ActiveSheet.Rows(1) '第1行
'Set 区域 = ActiveSheet.Columns(1) '第1列
'Set 区域 = ActiveSheet.Range("A1", "C3") '创建区域对象
'Set 头 = ActiveSheet.Cells(2, 2)
'Set 尾 = ActiveSheet.Cells(3, 3)
'Set 区域 = ActiveSheet.Range(头, 尾) '创建区域对象
Set 确定区域 = ActiveSheet.Range(Cells(2, 2).Address, Cells(3, 3).Address) '通过地址创建区域对象
Set 区域 = 确定区域(1, 1, 3, 3) '从（1，1）到（3，3）的区域
Function 确定区域(a, b, c, d) '从a行b列到c行d列的区域
Set 头 = ActiveSheet.Cells(a, b)
Set 尾 = ActiveSheet.Cells(c, d)
Set 确定区域 = ActiveSheet.Range(头, 尾) '参数
Set 确定区域 = ActiveSheet.Range(Cells(a, b).Address, Cells(c, d).Address) '通过地址创建区域对象
MsgBox 区域.Address '区域的位置
'MsgBox 区域.Cells.Count '区域单元格个数
'MsgBox 区域.SpecialCells(xlCellTypeVisible).Count '区域内可见单元格个数
'区域.Select '选中区域
'区域.ClearContents '清除区域内容
Sub 清空表单()
Set 区域 = Cells '全部区域
区域.ClearContents '清除区域内容
'区域.Merge '合并单元格
'区域.UnMerge '拆分单元格
'区域.VerticalAlignment = xlCenter '上下居中
'区域.HorizontalAlignment = xlCenter '左右居中
'区域.AutoFilter '筛选
'Set 单元格 = 区域.Find(1) '在区域里查找1,返回找到的第一个单元格
'MsgBox 单元格.Row '返回查找到的单元格的行
MsgBox 查找(区域, "1") '如果找到了就返回行和列，如果没找就返回空
Function 查找(区域, 定位词) '查找(区域, "1")
查找 = "" '查不到就是空
Set 单元格 = 区域.Find(定位词)
If Not 单元格 Is Nothing Then '判断是否找到，如果找不到，就是nothing
查找 = 单元格.Row & "*" & 单元格.Column
'查找 = 单元格.Address '区域的位置
End If
区域.EntireRow.Delete '删除整行
Sub 研究Cells()
'Set 单元格 = ActiveSheet.Cells(4, 3) '活动工作表4行3列的单元格
MsgBox 单元格.Address '单元格的地址
MsgBox 单元格(1, 3).Address '单元格向下平移1-1个单位，向右平移3-1个单位
'单元格.Value = "332424d4d"
'MsgBox 单元格 '单元格的文本信息，只读，不可以改
'MsgBox 单元格.Text '单元格的文本信息，只读，不可以改
'MsgBox 单元格.Value '单元格的文本信息，可以改
'MsgBox 单元格.Row '单元格的行
'MsgBox 单元格.Column '单元格的列
'MsgBox Cells(1).Row '单元格A1的行
'MsgBox Cells(1).Column '单元格A1的列
'MsgBox ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row '返回第2列最后一个非空单元格的行
'MsgBox ActiveSheet.Cells(1, 2).End(xlDown).Row '返回第2列第一个非空单元格的行
'MsgBox ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column '返回第4行最后一个非空单元格的列
'ActiveSheet.Hyperlinks.Add 单元格, "", Sheets(2).Name & "!A1" '链接到工作表
'ActiveSheet.Hyperlinks.Add 单元格, ThisWorkbook.Path '链接到文件或文件夹
'填写表单 ActiveSheet, 2, 3, Array(1, 2, 3) '第3列从非空行开始填数据，同时修改序号列第2列，序号数组为数据1，2，3，。。。
Sub 填写表单的准备工作()'似乎有漏洞，问题可能出在填写表单的开始位置的确定
批量新建表单准备工作
清空表单
Cells(3, 2) = "序号"
Cells(3, 3) = "数据"
Cells(4, 2) = 2
Sub 填写表单(表单, 序号列, 数据列, 数据) '填写表单 2, 序号数组(10)
非空行 = 表单.Cells(Rows.Count, 数据列).End(xlUp).Row + 1 '本列非空行的下一行
n = UBound(数据) '数组序号最大值
For i = 0 To n '遍历数组
表单.Cells(非空行 + i, 数据列) = 数据(i) '填写数据
If 表单.Cells(非空行 + i - 1, 序号列) = "序号" Then '判断是否是首行
表单.Cells(非空行 + i, 序号列) = 1 '修改序号
Else
表单.Cells(非空行 + i, 序号列) = 表单.Cells(非空行 + i - 1, 序号列) + 1 '修改序号
End If
Next
'遍历区域单元格 Selection, "单元格填充" '运行遍历区域单元格,单次函数名可改
Sub 单元格填充的准备工作()
批量新建表单准备工作
清空表单
Cells(3, 2) = "序号"
Cells(4, 2) = 1
Cells(6, 2) = 2
Cells(8, 2) = 3
Set 区域 = 确定区域(4, 2, 10, 2) '从（1，1）到（3，3）的区域
区域.Select '选中区域
Sub 遍历区域单元格(区域, 宏名) '遍历区域单元格 区域, "宏名"
Application.DisplayAlerts = False '不跳出警告对话框
If 区域.Cells.Count = 1 Then '如果区域就1个单元格就执行单次函数
Application.Run 宏名, 区域.Cells(1) '运行单次函数
Else
For Each 单元格 In 区域.SpecialCells(xlCellTypeVisible) '对可见单元格进行循环
Application.Run 宏名, 单元格 '运行单次函数
Next
End If
区域.Worksheet.Select '激活工作表
Application.DisplayAlerts = True '可以跳出警告对话框
'文件备份 '文件备份并记录编程时间,成功之后可以注释
Sub 单元格填充(单元格) '批量调用：'遍历区域单元格 Selection, "单元格填充"
If 单元格 = "" Then
'行 = 单元格.Row
'列 = 单元格.Column
'ActiveSheet.Cells(行, 列) = ActiveSheet.Cells(行 - 1, 列)
单元格.Value = 单元格(0, 1).Value '(0, 1)表示单元格向上平移一个单位
End If
Word.Application
Sub 研究Application()
Set word工程 = Application
word工程.DisplayAlerts = False '不跳出警告对话框
word工程.Visible = False '不可视,可删
word工程.Visible = True '可视,可删
word工程.Activate '激活,可删，当可视时才可以激活
word工程.DisplayAlerts = True '可以跳出警告对话框
'word工程.Quit '退出Word对象 '跑通之后再解封
Sub 研究run()
'Application.Run "输出信息", "成功" '调用sub
Sub 输出信息(信息)
MsgBox 信息
MsgBox Application.Run("重复信息", "成功") '调用function
Function 重复信息(信息)
重复信息 = 信息 & 信息
Sub 研究document()
Sub 研究document的准备工作()
文件夹路径 = ThisDocument.Path & "\测试文件\"
文件全名 = ThisDocument.Path & "\测试文件\" & "测试文件1.docx" '同级文件夹里的文件
If Dir(文件夹路径, vbDirectory) = "" Then
MkDir 文件夹路径 '创建文件夹，前提是没有，否则报错
ElseIf Dir(文件全名, vbDirectory) = "" Then
Set word文档 = Documents.Add
word文档.SaveAs 文件全名
word文档.Close
End If
'MsgBox Thisdocument.FullName '文件名及路径，即文件全名
'MsgBox Thisdocument.Path '路径
'MsgBox Thisdocument.Name '文件名及后缀，即文件名
'MsgBox Thisdocument.Path & "\同级文件夹" '同级文件夹
'MsgBox Thisdocument.Path & "\文件名" '同级文件
'MsgBox Thisdocument.Path & "\同级文件夹\" & "文件名" '同级文件夹里的文件
'Set word文档 = GetObject(文件全名) '创建对象，不打开文档
'文件全名 = ThisDocument.Path & "\测试文件\" & "测试文件1.docx" '同级文件夹里的文件
'Set word文档 = Documents.Open(文件全名) '创建对象，打开文档
'Set word文档 = Documents.Add '创建对象，打开新空白文档
'Set word文档 = Documents(ThisDocument.Name) '创建对象，必须是已打开文档
'word文档.Close wdSaveChanges '关闭文档并保存修改
'word文档.SaveAs2 文件全名
'word文档.SaveAs2 新文件全名, wdFormatPDF '保存为pfd格式
'新文件全名 = ThisDocument.Path & "\测试文件\" & "测试文件1.pdf" '同级文件夹里的文件
Sub 研究range()
Set 区域 = ActiveDocument.Range '创建区域对象
'Set 区域 = ActiveDocument.Range(1, 2) '创建区域对象
'MsgBox 区域.Start '区域头位置
'MsgBox 区域.End '区域尾位置
'MsgBox 区域.Paragraphs.Count '区域包含的段落数
'MsgBox 区域.Paragraphs(4) '区域包含的第4段内容
区域.Paragraphs(1).Range.Delete '删除所在行
'MsgBox 区域.Paragraphs(4).Range.Start '区域包含的第4段区域的头
'MsgBox 区域.Paragraphs(4).Range.End '区域包含的第4段区域的尾
'区域.Select '选中区域,可以辅助可视化
'区域.Copy '复制区域
'区域.Cut '剪去区域
'区域.Delete '删除区域
'区域.Paste '在区域后粘贴粘贴板内容
'word文档.Range.InsertAfter ("尾") '在区域后插入文本
'Set word文档 = Documents.Add '创建对象，打开新空白文档
'word对象.Range.InsertBefore ("头") '在区域前插入文本
'word文档.Range.InsertFile 文件全名 '在区域后插入文件
'文件全名 = ThisDocument.FullName '文件名及路径
'word文档.Range.InsertBreak '在区域后插入分页符,但是之前的内容被删，需要注意
'区域.ExportFragment 片段全名, wdFormatDocumentDefault '保存区域为docx文档
'Set 区域 = ActiveDocument.Paragraphs(4).Range '创建区域对象
'片段全名 = ActiveDocument.Path & "\测试文件\" & "片段1.docx" '同级文件夹里的文件
'区域.find.Execute ("模块")
'MsgBox 区域 '如果查到内容区域就改为查找内容，否则还是原区域
'MsgBox 区域.find.Found '判断是否查找到
ppt.Application
Sub 研究Application()
Set ppt工程 = Application
ppt工程.DisplayAlerts = False '不跳出警告对话框
ppt工程.Activate '激活,可删，当可视时才可以激活
ppt工程.DisplayAlerts = True '可以跳出警告对话框
'ppt工程.Quit '退出Word对象 '跑通之后再解封
Sub 研究run()
'Application.Run "输出信息", "成功" '调用sub
Sub 输出信息(信息)
MsgBox 信息
MsgBox Application.Run("重复信息", "成功") '调用function
Function 重复信息(信息)
重复信息 = 信息 & 信息
Sub 研究Presentation的准备工作()
文件夹路径 = ActivePresentation.Path & "\测试文件\"
文件全名 = ActivePresentation.Path & "\测试文件\" & "测试文件1.pptx" '同级文件夹里的文件
If Dir(文件夹路径, vbDirectory) = "" Then
MkDir 文件夹路径 '创建文件夹，前提是没有，否则报错
ElseIf Dir(文件全名, vbDirectory) = "" Then
Set ppt文稿 = Presentations.Add
ppt文稿.SaveAs 文件全名
ppt文稿.Close
End If
Sub 研究Presentation() 'ppt文稿
Set 初始ppt文稿 = ActivePresentation '当前ppt文稿
'MsgBox 初始ppt文稿.FullName '文件名及路径，即文件全名 没有thisPresentation
'MsgBox 初始ppt文稿.Path '路径
'MsgBox 初始ppt文稿.Name '文件名及后缀，即文件名
'文件全名 = 初始ppt文稿.Path & "\测试文件\" & "测试文件1.pptx" '同级文件夹里的文件
'Set ppt文稿 = GetObject(文件全名) '创建对象，不打开文档
'Set ppt文稿 = Presentations.Open(文件全名) '创建对象，打开文档
'Set ppt文稿 = Presentations.Add '创建对象，打开新空白文档
'Set ppt文稿 = Presentations(初始ppt文稿.Name) '创建对象，必须是已打开文档
'ppt文稿.SaveAs 文件全名 '保存之前务必打开已存在的文件再关闭
新文件全名 = 初始ppt文稿.Path & "\测试文件\" & "测试文件1.pdf" '同级文件夹里的文件
初始ppt文稿.SaveAs 新文件全名, ppSaveAsPDF '至少有一页才可以保存，否则报错
'ppt文稿.Close '关闭文档之前务必进行保持
Sub 研究Slide()'幻灯片
Set 初始ppt文稿 = ActivePresentation '当前ppt文稿
'MsgBox 初始ppt文稿.Slides(6).Name 'slides必须加对象，名字一般是Slide3等，与时间顺序有关
'MsgBox 初始ppt文稿.Slides(6).Layout '版式号
MsgBox ActiveWindow.Selection.SlideRange(2).Name
'初始ppt文稿.Slides.Add 1, ppLayoutBlank '在第1个位置添加一个空白幻灯片
Set 版式 = 初始ppt文稿.SlideMaster.CustomLayouts(7) '第7个母版，即空白模板
Set 幻灯片 = 初始ppt文稿.Slides.AddSlide(1, 版式) '在第1个位置添加一个空白幻灯片
InsertFromFile
Sub 研究Shapes()
Set 幻灯片 = ActivePresentation.Slides(2)
'MsgBox 幻灯片.Shapes(1).Left & "--" & 幻灯片.Shapes(1).Top
'MsgBox 幻灯片.Shapes(1).TextFrame.TextRange.Font.Color
'MsgBox 幻灯片.Shapes(1).TextFrame.TextRange.Font.Size
Set 文本框 = 幻灯片.Shapes.AddTextbox(msoTextOrientationHorizontal, 11, 484, 60, 100)
文本框.TextFrame.TextRange.Text = 12
文本框.TextFrame.TextRange.Font.Size = 28
文本框.TextFrame.TextRange.Font.Color = 14277081
文本框.Delete
TextFrame
TextRange
综合代码
excel控制文件
Sub 文件名及路径()
'MsgBox ThisWorkbook.FullName '文件名及路径，即文件全名
'MsgBox ThisWorkbook.Path '路径
'MsgBox ThisWorkbook.Name '纯文件名及后缀
'MsgBox ThisWorkbook.Path & "\同级文件夹" '同级文件夹
'MsgBox ThisWorkbook.Path & "\文件名" '同级文件
'MsgBox ThisWorkbook.Path & "\同级文件夹\" & "文件名" '同级文件夹里的文件
'MsgBox 对话框选择文件夹 '用对话框选择文件夹
Function 对话框选择文件夹()
对话框选择文件夹 = ""
Set 对话框 = Application.FileDialog(msoFileDialogFolderPicker) '对话框有4种，msoFileDialogFolderPicker是文件夹
对话框.InitialFileName = ThisWorkbook.Path '初始路径
If 对话框.Show = -1 Then
对话框选择文件夹 = 对话框.SelectedItems(1) '对话框选中的文件夹
End If
Sub 文件操作()
Sub 文件操作的准备工作()
文件夹路径 = ThisWorkbook.Path & "\测试文件\"
文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件1.xlsx" '同级文件夹里的文件
If Dir(文件夹路径, vbDirectory) = "" Then
MkDir 文件夹路径 '创建文件夹，前提是没有，否则报错
ElseIf Dir(文件全名, vbDirectory) = "" Then
Set 工作薄 = Workbooks.Add
工作薄.SaveAs 文件全名
工作薄.Close
End If
文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件1.xlsx" '同级文件夹里的文件
Set 文件系统 = CreateObject("Scripting.FileSystemObject") '创建对象
Set 文件对象 = 文件系统.getFile(文件全名) '创建对象
'MsgBox 文件对象.Name '文件名,可修改
'MsgBox 文件对象.Path '文件全名
'MsgBox 文件对象.DateCreated '创建时间
'新文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件2.xlsx" '同级文件夹里的文件
'文件对象.Copy 新文件全名 '执行复制操作
Sub 文件夹操作()
'文件夹路径 = ThisWorkbook.Path & "\测试文件\测试文件夹1"
文件夹路径 = 对话框选择文件夹 '用对话框选择文件夹
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
Set 文件夹对象 = 文件系统.getFolder(文件夹路径)
'MsgBox 文件夹对象.Name '文件夹名,可修改
'MsgBox 文件夹对象.Path '文件夹全名
'MsgBox 文件夹对象.subfolders.Count '子文件夹个数
'MsgBox 文件夹对象.Files.Count '文件个数
'MsgBox 文件夹对象.parentfolder '文件夹路径
'MsgBox 文件夹对象.DateCreated '创建时间
'新文件夹 = ThisWorkbook.Path & "\测试文件\测试文件夹2"
'文件夹对象.Copy 新文件夹
MsgBox 遍历文件夹文件(文件夹对象, "文件名_路径_创建时间") '遍历文件夹里的所有文件信息
Function 遍历文件夹文件(文件夹对象, 函数名) '递归查找+操作
文件信息 = "" '递归初始值
For Each 文件 In 文件夹对象.Files
文件信息 = 文件信息 & Application.Run(函数名, 文件) '返回文件信息，函数名可是"文件名_路径_创建时间"
Next
For Each 文件夹 In 文件夹对象.subFolders
文件信息 = 文件信息 & 遍历文件夹文件(文件夹, 函数名) '递归调用自身
Next
遍历文件夹文件 = 文件夹对象.Path & 文件信息 '开头信息为文件夹全名
Function 文件名_路径_创建时间(文件) '生成文件信息
文件名_路径_创建时间 = "*" & 文件.Name & "*" & 文件.ParentFolder & "*" & 文件.DateCreated '生成信息
excel控制word
Sub 调用word宏及函数()
Set 单元格 = ActiveSheet.Cells(1, 1) '创建区域对象
'调用word宏 "word宏", 单元格 '单元格作为参数就是文本信息
Sub 调用word宏(宏名, 参数) '调用word宏 "宏名", 参数
文件全名 = ThisWorkbook.Path & "\使用说明.docm" '同级文件
Set WordApp = CreateObject("Word.Application") '创建word工程
Set word对象 = WordApp.Documents.Open(文件全名) '创建word对象
WordApp.Visible = True '可视,可删
WordApp.Activate '激活,可删
WordApp.Run 宏名, 参数
'word对象.Close True '关闭文档 '跑通之后再解封
'WordApp.Quit '退出Word对象 '跑通之后再解封
MsgBox 调用word函数("word函数", 单元格) '测试代码是否成功
Function 调用word函数(宏名, 参数) '返回值 = 调用word函数("函数名", 参数)
文件全名 = ThisWorkbook.Path & "\使用说明.docm" '同级文件
Set WordApp = CreateObject("Word.Application") '创建word工程
Set word对象 = WordApp.Documents.Open(文件全名) '创建word对象
WordApp.Visible = True '可视,可删
WordApp.Activate '激活,可删
调用word函数 = WordApp.Run(宏名, 参数)
'word对象.Close True '关闭文档 '跑通之后再解封
'WordApp.Quit '退出Word对象 '跑通之后再解封
excel控制ppt
Sub 批量添加文本框()
时间数组 = Array(0, 5, 11, 21, 34, 56)
a = UBound(时间数组) + 1
b = ActivePresentation.Slides.Count - 4
n = (a + b - Abs(a - b)) / 2
For i = 0 To n - 1
Set 幻灯片 = ActivePresentation.Slides(i + 3)
Set 文本框 = 幻灯片.Shapes.AddTextbox(msoTextOrientationHorizontal, 11, 484, 60, 100)
文本框.TextFrame.TextRange.Text = 时间数组(i)
文本框.TextFrame.TextRange.Font.Size = 28
文本框.TextFrame.TextRange.Font.Color = 14277081
Next
End Sub
控制报错
On Error
项目总结
语句模型
选择
Sub 分类()
男女分类 1
Sub 男女分类(类别)
Select Case 类别
case 1
msgbox "男"
case 2
msgbox "女"
End Select
循环
Sub 求和()
MsgBox foreach循环求和(100)
Function for循环求和(n) '知道循环次数时用for循环
s = 0
For i = 1 To n
s = s + i
Next
for循环求和 = s
'MsgBox for循环求和(100)
Function foreach循环求和(n) '知道集合或数组时用foreach循环
s = 0
For Each i In 序号数组(n)
s = s + i
Next
foreach循环求和 = s
'MsgBox while循环求和(100)
Function while循环求和(n) 'while wend可以改为if endif，相当于只循环一次
i = 1
s = 0
While i <= n
s = s + i
i = i + 1
Wend
while循环求和 = s
'MsgBox 递归求和(100)
Function 递归求和(n) '递归有待研究，似乎可以相当于if以及逆向思维
If n > 1 Then
递归求和 = 递归求和(n - 1) + n
Else
递归求和 = 1
End If
小功能
新建表单或复制表单
Sub 研究Worksheet()
添加链接
Sub 研究Cells()
Function 确定区域(a, b, c, d) '从a行b列到c行d列的区域
Sub 研究range()
Sub 清空表单()
Sub 研究range()
Sub 填写表单(表单, 序号列, 数据列, 数据) '填写表单 2, 序号数组(10)
Sub 研究Cells()
Sub 遍历区域单元格(区域, 宏名) '遍历区域单元格 区域, "宏名"
Sub 研究Cells()
Sub 单元格填充(单元格) '批量调用：'遍历区域单元格 Selection, "单元格填充"
Sub 研究Cells()
Function 对话框选择文件夹()
Sub 文件名及路径()
文件或文件夹存在否
Sub 研究Worksheet()
小项目
Sub 批量新建表单()
Sub 批量新建表单准备工作()
If 工作表存在否("新建项目") = 0 Then
Sheets.Add '创建新表单
ActiveSheet.Name = "新建项目"
End If
If 工作表存在否("实验区") = 1 Then
Sheets("实验区").Select '激活表单
Else
Sheets.Add '创建新表单
ActiveSheet.Name = "实验区"
End If
清空表单
Cells(3, 2) = "序号"
Cells(4, 2) = "序号"
Cells(6, 2) = "序号"
Cells(8, 2) = "序号"
Set 区域 = 确定区域(4, 2, 10, 2) '从（1，1）到（3，3）的区域
区域.Select '选中区域
'遍历区域单元格 Selection, "新建项目" '批量新建表单
Sub 新建项目(单元格)
If 单元格 <> "" Then
If 工作表存在否(单元格) = 0 Then
Sheets("新建项目").Copy , Sheets("新建项目") '复制工作表并放在工作表后面
ActiveSheet.Name = 单元格
End If
单元格.Worksheet.Hyperlinks.Add 单元格, "", 单元格 & "!A1" '链接到工作表
End If
Sub 批量新建表单_重名自动改()
遍历区域单元格 Selection, "新建项目_重名自动改" '批量新建表单_重名自动改
Sub 新建项目_重名自动改(单元格)
If 单元格 <> "" Then
Sheets("新建项目").Copy , Sheets("新建项目") '复制工作表并放在工作表后面
ActiveSheet.Name = 修改表名直到不重(单元格)
单元格.Worksheet.Hyperlinks.Add 单元格, "", 单元格 & "!A1" '链接到工作表
End If
Sub 批量删除表单()'慎用
遍历区域单元格 Selection, "删除项目" '运行遍历区域单元格,单次函数名可改
Sub 删除项目(单元格)
If 工作表存在否(单元格) = 1 And 单元格 <> "" Then
Sheets(单元格.Text).Delete '删除工作表
End If
单元格.ClearContents '清除区域内容
Sub 批量新建文件()
遍历区域单元格 Selection, "新建文件" '运行遍历区域单元格,单次函数名可改
Sub 新建文件(单元格)
文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件1.docx" '同级文件夹里的文件
新文件全名 = ThisWorkbook.Path & "\测试文件\" & 单元格 & ".docx" '同级文件夹里的文件
Set 文件系统 = CreateObject("Scripting.FileSystemObject") '创建对象
Set 文件对象 = 文件系统.getFile(文件全名) '创建对象
文件对象.Copy 新文件全名 '执行复制操作
ActiveSheet.Hyperlinks.Add 单元格, 新文件全名 '链接到文件或文件夹
Sub 调用文件操作宏() '可删
文件全名 = ThisWorkbook.Path & "\测试文件\" & "测试文件1.docx" '同级文件夹里的文件
新文件全名1 = ThisWorkbook.Path & "\测试文件\" & "测试文件1副本.docx" '同级文件夹里的文件
新文件全名2 = ThisWorkbook.Path & "\测试文件\" & "测试文件1" & 格式化时间(Now) & ".docx" '同级文件夹里的文件
新文件全名3 = ThisWorkbook.Path & "\测试文件\" & "测试文件1_" & Right(0 & 1, 2) & ".docx" '同级文件夹里的文件
文件操作宏 文件全名, 新文件全名1, "复制" '调用文件操作
Sub 文件操作宏(文件全名, 操作信息, 操作) '可删
Set 文件系统 = CreateObject("Scripting.FileSystemObject") '创建对象
Set 文件对象 = 文件系统.getFile(文件全名) '创建对象
Select Case 操作
Case "复制"
文件对象.Copy 操作信息 '执行复制操作
Case "改名"
文件对象.Name = 操作信息 '执行改名操作
Case "删除"
文件对象.Delete '执行改名操作
End Select
文件操作宏 文件全名, 新文件全名2, "复制" '调用文件操作
文件操作宏 文件全名, 新文件全名3, "复制" '调用文件操作
Sub 文件备份() '
文件全名 = ThisWorkbook.FullName '文件名及路径
文件名 = ThisWorkbook.Name '文件名包括后缀
新文件名 = 文件名更换(文件名, 格式化日期(Date), "后") '调用文件名更换
Function 文件名更换(文件名, 更换信息, 位置) '可删
文件后缀 = Right(文件名, Len(文件名) - InStrRev(文件名, "."))
纯文件名 = Left(文件名, InStrRev(文件名, ".") - 1) '
Select Case 位置
Case "后"
文件名更换 = 纯文件名 & 更换信息 & "." & 文件后缀
Case Else
文件名更换 = 更换信息 & "." & 文件后缀
End Select
新文件全名 = ThisWorkbook.Path & "\历史版本\" & 新文件名 '同级文件夹里的文件
文件操作宏 文件全名, 新文件全名, "复制" '调用文件操作
新文件名 = 文件名更换(文件名, 格式化日期(date), "后") '调用文件名更换
新文件全名 = ThisWorkbook.Path & "\历史版本\" & 新文件名 '同级文件夹里的文件
文件操作宏 文件全名, 新文件全名, "复制" '调用文件操作
填写表单 Sheets("历史版本"), 3, 4, Array(新文件名)
调用清理多余文件 '文件太多时自动清理
Sub 调用清理多余文件() '工作表, 文件数, 最大数, 序号列=3, 数据列=4, 数据首行=5
Set 工作表 = Sheets("历史版本") '创建对象
文件数 = 工作表.Cells(4, 2) '单元格
最大数 = 工作表.Cells(3, 2) '单元格
清理多余文件 工作表, 文件数, 最大数, 3, 4, 5 '调用清理多余文件
Sub 清理多余文件(工作表, 文件数, 最大数, 序号列, 数据列, 数据首行)
多余数 = 文件数 - 最大数 '文件太多了就删
If 多余数 > 0 Then '文件太多时调用
For i = 1 To 多余数 '遍历多余文件
Set 单元格 = 工作表.Cells(数据首行, 数据列) '创建对象,由于一边删除，所以新文件还是首行
删除历史版本 单元格 '删除文件，注意删除行后新行数据是新首行数据
Sub 删除历史版本(单元格)
文件全名 = ThisWorkbook.Path & "\历史版本\" & 单元格 '同级文件夹里的文件
Set 文件系统 = CreateObject("Scripting.FileSystemObject") '创建对象
Set 文件对象 = 文件系统.getFile(文件全名) '创建对象
文件对象.Delete '删除文件
工作表.Rows(数据首行).Delete '删除行，不断的删除首行，就是删除所有多余行
Next
For i = 1 To 最大数 '最大数就是剩下的文件数
Set 单元格 = 工作表.Cells(数据首行 + i - 1, 序号列) '序号改为从1开始新的数据
单元格.Value = 单元格.Value - 多余数 '原序号减去多余数即可
Next
End If
大项目
word备份文件 '为了防止文件损坏及时备份
Sub 备份文件()
文件路径 = ThisDocument.Path '路径
文件全名 = ThisDocument.FullName '文件名及路径
文件名 = ThisDocument.Name '文件名及后缀
后缀位置 = InStrRev(文件名, ".")
纯文件名 = Left(文件名, 后缀位置 - 1)
文件后缀 = Right(文件名, Len(文件名) - 后缀位置 + 1)
新文件全名 = 文件路径 & "\历史版本\" & 纯文件名 & 格式化日期(Date) & 文件后缀 '同级文件夹里的文件
ActiveDocument.SaveAs2 新文件全名 '文件另存为
新文件全名 = 文件路径 & "\历史版本\" & 纯文件名 & 格式化时间(now) & 文件后缀 '同级文件夹里的文件
ActiveDocument.SaveAs2 新文件全名 '文件另存为
ActiveDocument.SaveAs2 文件全名 '文件另存为,以上操作是为了备份
ThisDocument.Range.InsertAfter Chr(10) & 新文件全名 '在区域后插入文本
删除多余文件
Sub 删除多余文件()
Set 区域 = ThisDocument.Range '创建区域对象
区域.find.Execute ("【历史版本】") '查找对应位置
区域.End = ThisDocument.Range.End '区域扩展到最后
文件数 = 区域.Paragraphs.Count - 1 '文件数=段落数-1
首段 = 区域.Paragraphs(1) '首段信息
尾 = InStrRev(首段, "】") '【n】的尾
头 = InStrRev(首段, "【") '【n】的头
最大数 = Int(Mid(首段, 头 + 1, 尾 - 头 - 1))
For i = 1 To 文件数 - 最大数
信息首段 = 区域.Paragraphs(2)
文件全名 = Left(信息首段, Len(信息首段) - 1)
Set 文件系统 = CreateObject("Scripting.FileSystemObject") '创建对象
Set 文件对象 = 文件系统.getFile(文件全名) '创建对象
文件对象.Delete
区域.Paragraphs(2).Range.Delete
Next
系统
文件系统
日程系统
项目及系统
系统
文件命名规则
**库
文件夹
**库平台
xlm格式
**整理
xlm格式
教学系统
试卷库平台
操作
一键更新已分解列表
遍历题库文件
如果文件名最后是01.docx
记录在列表中
否则
跳过
一键试卷分解
判断是否能分解
Yes
题目放到题库
更新已分解试卷列表
是否分解=1
已解决
No
是否分解-0
已解决
excel端提取数据
单元格
文件名
文件路径
word端实验
参数
文件名
2017-2018学年浙江省杭州市萧山区七年级（上）期中数学试卷.docx
文件路径
D:\360安全云盘同步版\我\技术天地\excelvba研究\项目_试卷系统\试卷库\杭州初中数学\七上\期中
遍历试卷题目
步骤
打开文件（文件名,文件路径）
为了遍历区域单元格模型
题目与答案分区
题目与答案分区定位词
调用递归查找函数
返回位置列表
答案查找
在答案区内
答案定位词
调用递归查找函数
返回位置列表
题型查找
在题目区内
题型定位词
记录题型名
调用递归查找函数
返回位置列表
题目查找
循环在题型内
题目定位词
调用递归查找函数
返回位置列表
记录题型题号
即对应题型中最大题号
递归查找函数
范围,定位词
范围不断的切分和缩小
遇到问题
如果前一题最后是表格，则搜不到本题
解决方法1
所有表格后面加回车
解决方法2
搜索时不加回车
题目没有问题了，但是题型又不行了
只能把题目查找与题型查找分开
逻辑
excel端
遍历区域单元格
单元格相关函数
参数是单元格
生成文件名和文件路径
执行调用word函数
参数为文件名和文件路径的数组
问题
如果选择的单元格是一个，就会出错
遍历区域单元格 Selection, "分析对应文件"
分析对应文件(单元格)
调用word带参数宏 "是否分解试卷", FilePath & "*" & Filename
需求：
- [ ] 分解试卷继续深化，代码总结一下
题库平台
需求：
- [ ] 2.考点整理和自动分析-编程
有了题目ID是否题目就好查找了
考点整理
考点分析
是否是综合即多章知识
是否是单章知识
比如二元一次方程组考点
方程的解
重点
解方程
不难
方程的应用
重点
先建立大纲表单
章、节、部分、年级等信息
题库及相关操作
比如录入题库之后一键剪贴到题库总表里
题目列表
题目总表
相关准备
试卷系统相关操作
试卷分解
从试卷系统复制题目过来
相关操作
最后行
全选中
判断年级
修改题型
提取考点
查找答案
题集库平台
需求：
独立出来
- [ ] 创建题集时教师版只要答案，比如故答案为后面的
题目去分数和去出处
excel端
遍历单元格
word端
打开文件
区域查找
方法1
定位词
期中）或期末）或模拟
对于中考题不行
方法2
先判断是否有出处
方法
查找）
判断）前是否是分并且分前是否是0到20之间的数
即分数
如果找到
确定有分数
向后查找（
判断(后是否是1900之2100之间的整数
即年份
如果是
确定有出处
如果否
确定没有出处
如果没有找到
确定没有分数
重新查找（
判断(后是否是1900之2100之间的整数
即年份
如果是
确定有出处
如果否
确定没有出处
方法提炼
确定一个字符串是否是一个范围内的数
把字符串变为数
判断大小
注意：函数参数包括：文件对象,题目范围头,题目范围尾
课件库平台
需求：
- [ ] 完善excel做的备课平台：1.课表；2.课程；3.课后反馈；4.学员评价；5.教学平台，比如教学规划，教学问题，解决方案，课件及资料整理等；6.平台优化；-工作
每日一练整理
每日一练平台
题目列表
题目
题型
答案
信息的提取
生成列表
输入数据
日期
可自动已有日期
天数
生成每日一练
生成文件
需要文件组装
删除答案
更改pdf格式
生成数据
日期
题号
更新数据列表
单元格信息录入
需求：
独立出来
每日一练系统
题目列表
初一
初二
初三
相关准备
题库相关操作
判断年级
修改题型
提取考点
查找答案
从题库复制题目过来
查重题
相关操作
最后行
全选中
生成每日练
每日练答案
做题整理
教学系统开发
试卷库
题库
题集库
课件库
开发库
文件夹
**平台或整理-更新功能-时间.xlm
开发库平台
开发库平台.xlm
文件系统
需求：
文件定期自动备份
一键生成新系统
文件
文件夹
日程系统
独立系统，既包括工作也包括生活
独立系统好处
数据可以放到不同的列表
用快捷方式打开对应日程表
暂存
自动生成当天的日程表
excel
按钮1
日程表
判断当天周几
搜索对应日程表位置
利用查找或固定位置转化为范围
复制特定范围
头单元格坐标，尾单元格坐标
粘贴到特定位置
单元格坐标
按钮i2
特假日程表
按钮3
寒暑日程表
项目
自动宏
一启动就执行
需求
移植问题
vba程序如何快速的移植到另一个文件
方法1
excel里添加按钮
优点
个人电脑使用方便
缺点
更换电脑或使用他人电脑不方便
代码存储不方便
缺点解决方案
学习自动添加按钮的方法
方法2
创建文件模板
方法3
复制文件薄
方法4
复制整个文件
优点
代码和按钮都可移植
缺点
后续更新不能统一及时更新
需求分析
案例
表面意思
新建文件并修改名字并链接
深入分析
新建文件（是否需要模板，如果有模板就复制），复制时改名一并解决，链接一行代码即可
深入研究
文件对象.copy 新文件名（包括路径和后缀）需要路径和文件名快速生成
需求
系统模板的建立及维护
office安装2019
研究excel与ppt结合,之前研究过
数据备份到移动硬盘
新需求
excel遍历区域单元格模型当选中一个单元格时出错
编程系统
vba系统
编程思路
word
宏主体
信息准备即参数
word路径和名称
方法1
FilePath = Left(ThisDocument.FullName, InStrRev(ThisDocument.FullName, "\"))
FileName = FilePath & "输入文件" & "\" & "测试文件1.docx"
用到的vb函数
Left
InStrRev
&
方法2
MainPath=ThisDocument.path & "\"
FilePath = MainPath & "输入文件" & "\"
FileName = "测试文件1.docx"
方法3
弹窗
pdf路径和名称
方法1
PdfPath = MainPath & "输出文件" & "\"
PdfName = Left(FileName, InStrRev(FileName, ".")) & "pdf"
对象创建即打开
方法1
set word对象=Documents.Open(word路径和名称)
可视而且就算已打开也可以
方法2
set word对象=Documents（word路径和名称）
需要已打开并已知文件名
方法3
set word对象=Documents.add
创建空文档并可视
方法4
set word对象=getobject（word路径和名称）
文件在后台打开不显示
在excel用不了，暂不知道为什么
文件操作及信息提取
片段查找和定位
单次执行
宏
'最简单模式
定位词 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
Set 查找对象 = 文件对象.Range
查找对象.find.Execute (定位词)
查找对象.Select'可视化
'记录位置模式
定位词 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
Set 查找对象 = 文件对象.Range
查找对象.find.Execute (定位词)
If 查找对象.find.Found Then
位置 = 查找对象.Start
else
位置 = ""
endif
msgbox 位置
函数
Sub 调用单次片段查找和定位()
定位词 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
Set 查找对象 = 文件对象.Range
msgbox 单次片段查找和定位（查找对象,定位词）
function 单次片段查找和定位（查找对象,定位词）
查找对象.find.Execute (定位词)
If 查找对象.find.Found Then
位置 = 查找对象.Start
else
位置 = ""
endif
单次片段查找和定位=位置
endfunction
循环执行
宏
'最简单模式
'参数
文件路径 = "D:\360安全云盘同步版\我\技术天地\excelvba研究\excelvba研究\项目_试卷系统\试卷库\杭州初中数学\八下\期中"
文件名 = "2020-2021学年浙江省杭州市西湖区西溪中学八年级（下）期中数学试卷.docx"
Set 文件对象 = Documents.Open(文件路径 & "\" & 文件名) 'open的返回值是对象
试卷名 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
定位词 = Array(试卷名, 试卷名)
Set 查找对象 = 文件对象.Range
'循环模型
下标 = 0
记录 = ""
尾 = 查找对象.End
查找对象.find.Execute (定位词(下标))
While 查找对象.find.Found
位置 = 查找对象.Start
记录 = 记录 & 位置 & "*"
查找对象.Start = 查找对象.End
查找对象.End = 尾
下标 = 下标 + 1
查找对象.find.Execute (定位词(下标))
Wend
MsgBox 记录
函数
Sub 调用循环片段查找和定位()
'参数
文件路径 = "D:\360安全云盘同步版\我\技术天地\excelvba研究\excelvba研究\项目_试卷系统\试卷库\杭州初中数学\八下\期中"
文件名 = "2020-2021学年浙江省杭州市西湖区西溪中学八年级（下）期中数学试卷.docx"
Set 文件对象 = Documents.Open(文件路径 & "\" & 文件名) 'open的返回值是对象
试卷名 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
定位词 = Array(试卷名, 试卷名)
Set 查找对象 = 文件对象.Range
'循环模型
MsgBox 循环片段查找和定位(查找对象, 定位词, 0)
End Sub
Function 循环片段查找和定位(查找对象, 定位词, 下标)
记录 = ""
尾 = 查找对象.End
查找对象.find.Execute (定位词(下标))
While 查找对象.find.Found
位置 = 查找对象.Start
记录 = 记录 & 位置 & "*"
查找对象.Start = 查找对象.End
查找对象.End = 尾
下标 = 下标 + 1
查找对象.find.Execute (定位词(下标))
Wend
循环片段查找和定位 = 记录
End Function
递归模型
Sub 调用递归片段查找和定位()
'参数
文件路径 = "D:\360安全云盘同步版\我\技术天地\excelvba研究\excelvba研究\项目_试卷系统\试卷库\杭州初中数学\八下\期中"
文件名 = "2020-2021学年浙江省杭州市西湖区西溪中学八年级（下）期中数学试卷.docx"
Set 文件对象 = Documents.Open(文件路径 & "\" & 文件名) 'open的返回值是对象
试卷名 = Chr(13) & Left(文件名, Len(文件名) - 5) '去掉了文件后缀
定位词 = Array(试卷名, 试卷名)
Set 查找对象 = 文件对象.Range
'循环模型
MsgBox 递归片段查找和定位(查找对象, 定位词, 0)
End Sub
Function 递归片段查找和定位(查找对象, 定位词, 下标)
尾 = 查找对象.End
查找对象.find.Execute (定位词(下标))
If 查找对象.find.Found Then
位置 = 查找对象.Start
查找对象.Start = 查找对象.End
查找对象.End = 尾
下标 = 下标 + 1
记录 = 记录 & 位置 & "*" & 递归片段查找和定位(查找对象, 定位词, 下标)
Else
记录 = ""
End If
递归片段查找和定位 = 记录
End Function
其他
情况1
中间定位词或序列
宏模式
除word对象外其他参数准备
查找对象创建
Set 查找对象 = word对象.Range
查找对象.Start = Len(定位词) '为了查找第二次出现标题所以不包括第一个标题
定位词设定
案例1
定位词 = word对象.Paragraphs(1).Range.Text '文档标题
定位词 = Left(定位词, Len(定位词) - 1) '去掉回车
序号设定
例如
序号 = 0
函数部分
初始头尾设定
查找对象
Start
End
案例1
初始头 = 查找对象.Start
初始尾 = 查找对象.End
片段树查找
查找对象.find.Execute (定位词)
'或'查找对象.find.Execute (定位词(序号))
If 查找对象.find.Found Then
头 = 初始头
尾 = 查找对象.Start
新头 = 查找对象.Start
新尾 = 初始尾
Set 查找对象 = word对象.Range(新头, 新尾)
片段树查找 = Array(Array(头, 尾), Array(Array(新头, 新尾), ""))
'函数化时需要改为递归调用
Else
片段树查找 = Array(Array(初始头, 初始尾), "")
End If
调用函数
片段树 = 片段树查找
片段树解读（用于其他对文件操作）
i = 0
Do While True
If VarType(片段树) >= vbArray Then
i = i + 1
片段 = 片段树(0)
头 = 片段(0)
尾 = 片段(1)
片段树 = 片段树(1)
Else
Exit Do
End If
Loop
宏模式函数化
宏模式剩下部分
除word对象外其他参数准备
查找对象创建
Set 查找对象 = word对象.Range
查找对象.Start = Len(定位词) '为了查找第二次出现标题所以不包括第一个标题
定位词设定
案例1
定位词 = word对象.Paragraphs(1).Range.Text '文档标题
定位词 = Left(定位词, Len(定位词) - 1) '去掉回车
序号
序号 = 1
调用函数
片段树 = 片段树查找
片段树解读（用于其他对文件操作）
i = 0
Do While True
If VarType(片段树) >= vbArray Then
i = i + 1
片段 = 片段树(0)
头 = 片段(0)
尾 = 片段(1)
片段树 = 片段树(1)
Else
Exit Do
End If
Loop
函数部分
初始头尾设定
查找对象
Start
End
案例1
初始头 = 查找对象.Start
初始尾 = 查找对象.End
片段树查找
查找对象.find.Execute (定位词)
If 查找对象.find.Found Then
头 = 初始头
尾 = 查找对象.Start
新头 = 查找对象.Start
’或‘新头 = 查找对象.Start + Len(定位词(序号))
新尾 = 初始尾
Set 查找对象 = word对象.Range(新头, 新尾)
'序号=序号+1
片段树查找 = Array(Array(头, 尾), 片段树查找(word对象, 查找对象, 定位词))
'或’片段树查找 = Array(Array(头, 尾), 片段树查找(word对象, 查找对象, 定位词, 序号))
Else
片段树查找 = Array(Array(初始头, 初始尾), "")
End If
应用
把一部分分为两部分
试卷题目部分的尾为试卷名第二次出现的前端再去掉一个回车
试卷答案部分的头为试卷名第二次出现的前端再去掉一个回车
把一部分分为两部分只取其中一部分
试卷选择题部分的尾为回车+“二”的前端
用递归循环分隔题型
比如试卷题型头为回车+”一”（或”二“或”三“,......）
用递归循环分隔题目
比如试卷题型头为回车+”1.”（或”2.“或”3.“,......）
比如试卷题目答案头为考点前端，尾为点评后端，for循环10次只为找前10题
情况2
固定头尾定位词
宏模式
除word对象外其他参数准备
定位词设定
案例1
头定位词 = "【考"
尾定位词 = "【点"
函数部分
查找对象创建
Set 查找对象 = word对象.Range
初始头尾设定
查找对象
Start
End
案例1
初始头 = 查找对象.Start
初始尾 = 查找对象.End
片段集信息提取
片段集创建
ReDim 片段集(100)
片段集查找
i = 0
Do While True
查找对象.find.Execute (头定位词)
If 查找对象.find.Found Then
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start '为了防止定位词里前面是回车
查找对象.End = 初始尾
查找对象.find.Execute (尾定位词)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End '保证结尾是段落最后
查找对象.End = 初始尾
i = i + 1
片段集(i) = Array(头, 尾)
Else
Exit Do
End If
Loop
查找-循环模型比较
方法1-5
方法1
缺点是必须把判断的节点用变量及代码记录下来
Do
查找对象.find.Execute (定位词头)
找到 = 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop While 找到
方法2（类似1）
Do
查找对象.find.Execute (定位词头)
找到 = 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop Until 找到 = 0 '找不到
方法3
缺点是循环外内有重复，而且判断的结点相关代码必须放在最后面
查找对象.find.Execute (定位词头)
While 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
查找对象.find.Execute (定位词头)
Wend
方法4（类似3）
查找对象.find.Execute (定位词头)
Do While 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
查找对象.find.Execute (定位词头)
Loop
方法5（对比4有跳出）
缺点是需要用if判断是否跳出
Do While True
查找对象.find.Execute (头定位词)
If 查找对象.find.Found=0 Then
Exit Do
End If
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (尾定位词)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop
方法6（类似5，有跳出机制）
优点是运行一次的代码可以很方便变成运行多次的代码， 比如头加dowhiletrue中else里加exitdo尾加loop
Do While True
查找对象.find.Execute (定位词头)
If 查找对象.find.Found Then
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Else
Exit Do
End If
Loop
片段集信息提取
片段数 = i
片段集信息提取 = Array(片段数, 片段集)
片段信息解读（用于其他对文件操作）
片段集信息 = 片段集信息提取
片段数 = 片段集信息(0)
片段集 = 片段集信息(1)
For i = 1 To 片段数
片段 = 片段集(i)
头 = 片段(0)
尾 = 片段(1)
Next
宏模式函数化
函数化过程： 1.复制sub,把函数主体部分留下其他删除， 2.原sub，把函数主体部分删除，把信息解读处加参数，改为函数调用 3.把sub改为function; 4.宏名称改为片段信息提取； 5.加参数，在函数定义与调用时
宏模式剩下部分
除word对象外其他参数准备
定位词设定
头定位词，尾定位词
函数的调用
片段集 = 片段集查找(word对象, 头定位词, 尾定位词)
片段信息解读（用于其他对文件操作）
片段数 = 片段集(0)
For i = 1 To 片段数
片段 = 片段集(i)
头 = 片段(0)
尾 = 片段(1)
Next
函数部分
查找对象创建
Set 查找对象 = word对象.Range
初始头尾设定
查找对象
Start
End
案例1
初始头 = 查找对象.Start
初始尾 = 查找对象.End
片段集信息提取
片段集创建
ReDim 片段集(100)
片段集查找
i = 0
Do While True
查找对象.find.Execute (头定位词)
If 查找对象.find.Found Then
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start '为了防止定位词里前面是回车
查找对象.End = 初始尾
查找对象.find.Execute (尾定位词)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End '保证结尾是段落最后
查找对象.End = 初始尾
i = i + 1
片段集(i) = Array(头, 尾)
Else
Exit Do
End If
Loop
查找-循环模型比较
方法1-5
方法1
缺点是必须把判断的节点用变量及代码记录下来
Do
查找对象.find.Execute (定位词头)
找到 = 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop While 找到
方法2（类似1）
Do
查找对象.find.Execute (定位词头)
找到 = 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop Until 找到 = 0 '找不到
方法3
缺点是循环外内有重复，而且判断的结点相关代码必须放在最后面
查找对象.find.Execute (定位词头)
While 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
查找对象.find.Execute (定位词头)
Wend
方法4（类似3）
查找对象.find.Execute (定位词头)
Do While 查找对象.find.Found
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
查找对象.find.Execute (定位词头)
Loop
方法5（对比4有跳出）
缺点是需要用if判断是否跳出
Do While True
查找对象.find.Execute (头定位词)
If 查找对象.find.Found=0 Then
Exit Do
End If
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (尾定位词)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Loop
方法6（类似5，有跳出机制）
优点是运行一次的代码可以很方便变成运行多次的代码， 比如头加dowhiletrue中else里加exitdo尾加loop
Do While True
查找对象.find.Execute (定位词头)
If 查找对象.find.Found Then
段落数 = 查找对象.Paragraphs.Count
头 = 查找对象.Paragraphs(段落数).Range.Start
查找对象.End = 初始尾
查找对象.find.Execute (定位词尾)
段落数 = 查找对象.Paragraphs.Count
尾 = 查找对象.Paragraphs(段落数).Range.End
查找对象.End = 初始尾
Else
Exit Do
End If
Loop
片段集信息提取
片段数 = i
片段集(0) = 片段数
片段集信息提取 = 片段集
‘或’片段集信息提取 = Array(片段数, 片段集)
应用
比如试卷题目答案头为考点前端，尾为点评后端
比如试卷题型头为回车+”1.”后端，尾为回车+”6.”前端
研究树形结构
试卷树
部分号
题型树
题型号
题集树
题目号
空
范围集
范围集
答案树
答案号
空
范围集
范围树
树
标题
树
题目部分
范围树
树
题型1
范围树
树
题目1
树
题目2
树
题目3
树
.。。。
树
题型2
范围树
树
题目11
树
题目12
树
题目13
树
.。。。
树
题型3
范围树
树
题目17
树
题目18
树
题目19
树
.。。。
空
空
树
答案部分
范围树
树
答案标题
树
答案1
树
间隔内容
树
答案2
树
间隔内容
树
答案3
.。。。
空
空
递归（定位树，范围树）
参数
序号
0
定位树=试卷树
定位
定位树（0）
部分号
范围
范围树（0）
试卷
范围树
递归（对像，范围，定位，序号）
树
标题
树
题目部分
树
答案部分
空
如果：定位树非空
次数
定位树上界
2
序号
2
范围树
范围树（1）
题目部分
树
答案部分
空
如果
定位树上界=1
那么
固定定位树
定位树（1）
次数=序号
递归（定位树）
否则
定位树
定位树（i）
题型树
次数=定位树上界
2
序号=0
递归（定位树，范围树）
i=1
定位
定位树（0）
题型号
范围
范围树（0）
题目部分
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题型1
树
题型2
树
题型3
空
如果：定位树非空
循环
次数
定位树上界
1
序号
3
如果
定位树上界=1
那么
固定定位树
定位树（1）
题集树
次数=序号
3
递归（定位树）
i=1
定位
定位树（0）
题目号
范围
范围树（0）
题目1
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题型1
树
题型2
空
如果：定位树非空
循环
次数
定位树上界
与序号有关
定位树
定位树（i）
递归（定位树）
否则
否则
定位树
定位树（i）
题型树
次数=定位树上界
2
序号
0
递归（定位树，范围树）
i=1
定位
定位树（0）
题型号
范围
范围树（0）
题目部分
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题型1
树
题型2
树
题型3
空
如果：定位树非空
循环
次数
定位树上界
与序号有关
定位树
定位树（i）
递归（定位树，范围树）
i=1
序号
0
定位
定位树（0）
范围
范围树（0）
题目1
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题型1
空
如果：定位树非空
循环
次数
定位树上界
与序号有关
定位树
定位树（i）
递归（定位树）
i=2
序号
0
定位
定位树（0）
范围
范围树（0）
题型2
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题目1
树
题型2
树
题型n
空
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=n
序号
0
定位
定位树（0）
范围
范围树（0）
题型1
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题目1
树
题型2
树
题型n
空
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
递归（定位树，范围树）
i=1
序号
0
定位
定位树（0）
范围
范围树（0）
题目1
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题型1
空
如果：定位树非空
循环
次数
定位树上界
与序号有关
定位树
定位树（i）
递归（定位树）
i=2
序号
0
定位
定位树（0）
范围
范围树（0）
题型2
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题目1
树
题型2
树
题型n
空
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=n
序号
0
定位
定位树（0）
范围
范围树（0）
题型1
范围树
递归（对像，范围，定位，序号）
树
题目1标题
树
题目1
树
题型2
树
题型n
空
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
循环
解读
定位
定位树（0）
部分号
循环
次数
定位树上界
2
定位树
定位树（i）
i=1
题型树
定位
定位树（0）
题型号
循环
次数
定位树上界
1
定位树
定位树（i）
i=1
定位
定位树（0）
题目号
题集树
空
i=2
答案树
定位
定位树（0）
答案号
循环
次数
定位树上界
1
定位树
定位树（i）
i=1
定位
定位树（0）
答案号
答集树
空
递归（定位树）
定位
定位树（0）
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=1
定位
定位树（0）
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=1
定位
定位树（0）
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=2
定位
定位树（0）
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
i=1
定位
定位树（0）
如果：定位树非空
循环
次数
定位树上界
定位树
定位树（i）
递归（定位树）
研究树形结构
试卷范围
if 范围2=空
刀=刀（1）
范围2
a(1，0)
=切（范围2，用刀）
else
刀=刀（0）
范围1
a(0，0)
=切（范围2，刀）
if 范围2=空
刀=刀（1）
范围2
a(1，0)
=切（范围2，用刀）
else
刀=刀（0）
范围1
a(0，1)
=切（范围2，刀）
if 范围2=空
刀=刀（1）
范围2
a(1，0)
=切（范围2，用刀）
else
刀=刀（0）
范围1
a(0，2)
=切（范围2，刀）
if 范围2=空
刀=刀（1）
范围2
a(0，2)
=切（范围2，用刀）
else
刀=刀（0）
范围2
a(0，3)
=切（范围2，用刀）
模型总结
单次定位
根据特征规律来定
参数
定位词
查找范围
set 查找范围=word对象.range
提取方式
案例1：填空题答案
头
定位词的尾
头=查找范围.end
尾
定位词所在段落的尾
尾=查找范围.paragraphs(1).range.end
查找
查找范围.find.execute(定位词)
if 查找范围.find.found then
按提取方式提取头和尾
合并文档
函数名及参数名
Sub 合成文档(打开路径,保存路径,文档集,生成名)
打开并创建word对象
Set word对象= Documents.Add '创建文档
标题设置
word对象.Range.InsertAfter (生成名 & Chr(13)) '插入标题
word对象.Paragraphs(1).Alignment = wdAlignParagraphCenter '剧中
'word对象.Paragraphs(1).SpaceAfter = InchesToPoints(0.5) '段落间距
批量插入文档
for i=0 to ubound(文档集)
插入题号
word对象.Range(word对象.Range.End - 1, word对象.Range.End - 1).InsertAfter (i + 1 & ".") '
现阶段最好的结果，其他方法都不行
插入文档
word对象.Range(word对象.Range.End - 1, word对象.Range.End - 1).InsertFile (FilePath & FileName(i) & ".docx")
现阶段最好的结果，其他方法都不行
删除片段
查找范围.find.Execute ("【考")
查找范围.End = word对象.Range.End
查找范围.Delete
生成pdf
关闭word对象
word对象.Close True '为了可视化先不执行此代码
提取信息
信息准备
输出路径和名称
word模板路径和名称
内容头，内容尾
对象创建
方法1
set word对象=Documents.add
创建空文档
方法2
set 新word对象=Documents.Open(word模板路径和名称)
方法3
set 新word对象=getobject（word模板路径和名称）
复制粘贴
方法1
selection
start
内容头
end
内容尾
copy
原word对象
paste
新word对象
方法2
range
start
内容头
end
内容尾
copy
原word对象
paste
新word对象
文件保存关闭
新word对象
saveas2 输出路径和名称
Close True
word转pdf
方法1
word对象.ExportAsFixedFormat pdf路径和名称, wdExportFormatPDF
方法2
word对象.savesas2 pdf路径和名称, wdExportFormatPDF
文件关闭
word对象
Close True
SaveChanges:=wdDoNotSaveChanges
不改变修改就关闭
set word对象=nothing
单次函数
调用函数的宏
信息准备即参数
文档路径
文档名称
msgbox 函数名（文档路径，文件名）
这里注意需要不要文旦后缀，因为excel信息提取时没有后缀
函数主体
对象创建即打开
文件操作及信息提取
文件关闭
宏转化为单次函数的方法
调用函数的宏
信息准备即参数
函数名（文档路径，文件名）
这里注意需要不要文旦后缀，因为excel信息提取时没有后缀
信息提取
需要修改为函数名=提取信息
批量函数
调用批量函数的宏
参数注意数组化
信息准备即参数
文档路径
它必须是参数，因为excel调用时文件夹名不一样
文档名称=array(文档1，文档2)
这里注意需要不要文旦后缀，因为excel信息提取时没有后缀
msgbox 函数名（文档路径，文件名称）
批量函数主体
循环模型+调用单次函数
返回值注意数组化
可以利用参数
转化方法
某些参数变为数组
主体函数中使用for循环或while循环
代码模型
转化
单次函数
批量函数
word与excel交互
函数化主要目的是为了excel调用时需要excel信息传到word端，否则word端不需要函数
批量化主要目的是把重复的地方找出来，可以不重复的地方在循环外
单次到批量转化过程中有两种方法
方法1
批量函数是独立的，只是在单次函数中重复部分加上循环
方法2
批量函数批量调用单次函数，需要把重复的部分找出来，单次函数要减少代码，多一些参数
excel可以直接调用word的批量函数，或者复制批量函数的代码
去可视化，可以变更文档对象的创建方式，比如改为get对象的方式
while1
Do While True
创造判断点
If 判断点成立 Then
提取信息或相关操作
Else
Exit Do
End If
Loop
while2
Do While True
创造判断点
If 判断点成立 Then
Exit Do
Else
提取信息或相关操作
End If
Loop
递归
函数部分
Function 片段树查找(word对象, 查找对象, 定位词)
初始头 = 查找对象.Start
初始尾 = 查找对象.End
查找对象.find.Execute (定位词)
If 查找对象.find.Found Then
头1 = 初始头
尾1 = 查找对象.Start - 1 '去掉回车
头2 = 查找对象.End
尾2 = 初始尾
Set 查找对象 = word对象.Range(头2, 尾2)
片段树查找 = Array(Array(头1, 尾1), 片段树查找(word对象, 查找对象, 定位词))
Else
片段树查找 = Array(Array(初始头, 初始尾), "")
End If
End Function
片段树解读（用于其他对文件操作）
i = 0
Do While True
If VarType(片段树) >= vbArray Then
i = i + 1
片段 = 片段树(0)
头 = 片段(0)
尾 = 片段(1)
片段树 = 片段树(1)
Else
Exit Do
End If
Loop
递归可以用while等循环程序走一遍，然后总结转化规律
excle
宏主体
提取列表信息
方法1
对话框输入，比如
题集名 = InputBox("输入题集名：", "题集名输入框", "新建题集")
方法2
默认固定信息，比如
'题集名 = "新建题集"
方法3
单元格提取，比如
'题集名 = ActiveSheet.Cells(2, 1)
方法4
选中区域或选中筛选区域提取，比如
题集 = 格集信息提取()
打开存储函数的word文件
MainPath = ThisWorkbook.Path & "\"
FilePath = MainPath & "题库\"
SavePath = MainPath & "每日一练\"
Set WordApp = CreateObject("Word.Application")
Set word对象 = WordApp.documents.Open(MainPath & "使用说明.docm")
调用word函数
调用宏
WordApp.Run "创建题集", 题库, 题集, 题集名, 题集库
调用函数
答案 = WordApp.Run("批量查找填空答案", 信息)
关闭存储函数的word文件及工程
WordD.Close True '关闭文档 '跑通之后再解封
Set WordD = Nothing '跑通之后再解封
WordApp.Quit '退出Word对象 '跑通之后再解封
用返回值接收信息
操作表单
新建表单
方法1
Sheets.Add ActiveSheet
在活动表单前面加
Sheets.Add , ActiveSheet
在活动表单后面加
ActiveSheet.Name = "好" '修改表单名
方法2
表单名1 = ActiveSheet.Name '记住表单名
Sheets("新建项目").Copy , Sheets("新建项目") '利用复制创建新工作表
ActiveSheet.Name = "好" '修改表单名
Sheets(表单名1).Select '回到操作表
添加链接
链接到文件
Set 区域 = ActiveSheet.Cells(3, 3)
ActiveSheet.Hyperlinks.Add 区域, 文件路径及文件名
链接到表单
Set 区域 = ActiveSheet.Cells(3, 3)
ActiveSheet.Hyperlinks.Add 区域, "", "项目管理!A1", , "项目管理"
修改单元格信息
ActiveSheet.Cells(行, 列) =信息
选中单元格
选中非空单元格
第1列非空行 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
第3列非空行 = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
If 第3列非空行 > 第1列非空行 Then
ActiveSheet.Range(Cells(第1列非空行 + 1, 3), Cells(第3列非空行, 3)).Select
选中最后一行非空单元格
第3列非空行 = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
ActiveSheet.Cells(第3列非空行 + 1, 3).Select
提取选中单元格信息
方法1
Set 单元格集合 = Selection.Cells
For Each 单元格 In 单元格集合
ActiveSheet.Cells(单元格.Row, 6) = ""
方法2
Set 单元格集合 = Selection.SpecialCells(xlCellTypeVisible)
被筛选的单元格
For Each 单元格 In 单元格集合
ActiveSheet.Cells(单元格.Row, 6) = 1
方法
首先在excel端提取数据，然后手动记录并作为word的参数，在word端测试
excel调用word又慢又容易死程序，所以务必总结好的流程和方法提高效率
代码模型
方法1
excel
打开存储函数的word文件
批量
提取列表单个信息
情况1
固定位置提取信息
情况2
选中区提取信息
解读信息
提取文件夹里的文档名
调用word函数
word
单次函数
对象创建即打开
信息准备
文件操作
提取信息
文件关闭
用返回值接收信息
解读信息并把信息列表化
方法2
excel
提取列表批量信息
情况1
固定位置提取信息
情况2
选中区提取信息
新建工程打开存储函数的word文件
调用word函数
word
批量函数
提取文件夹里的文档名
单次函数
对象创建即打开
信息准备
文件操作
提取信息
文件关闭
关闭存储函数的word文件及工程
用返回值接收信息
方法3
excel不需要调用word宏，但是需要创建wordapp,在所有word对象前加上wordapp.
或者直接创建word对象会怎么样子？
folder
信息准备即参数
word路径和名称
MainPath = ThisWorkbook.Path & "\"
FilePath = MainPath & "测试文件\"
文件夹管理
创建文件系统对象
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
创建文件夹对象
Set 文件夹对象 = 文件系统.GetFolder(FilePath)
子文件夹集
Set 子文件夹集 = 文件夹对象.SubFolders
文件集
For Each 子文件夹 In 子文件夹集
Set 文件集 = 子文件夹.Files
文件
For Each 文件 In 文件集
递归函数遍历文件夹里的文件
参数是文件夹对象
Function 查找文件(文件夹对象) '递归查找
用字符串传输数据，用特殊符号隔开，比如"*"
查找文件 = 查找文件 & 文件.Name & "*" & 文件.Path & "*" '用*是为了防止文件名里有空格
递归部分
查找文件 = 查找文件 & 查找文件(文件夹)
生成列表
ActiveSheet.Cells(行, 列) =信息
公共代码与模型
数组
Sub 研究数组()
序列 = 数组(10)
'MsgBox 序列(0) '1
'MsgBox 序列(10) '最后一个为空
'MsgBox LBound(序列)'0
'MsgBox UBound(序列)'10
重复序列 = 重复数组(1, 10)
'MsgBox 重复序列(0) '1
'MsgBox 重复序列(10) '最后一个为空
字符串 = "一 二 三 四 五 六 七 八 九"
字符串序列 = Split(字符串)
'MsgBox 字符串序列(0) '一
'MsgBox 字符串序列(8) '九
MsgBox UBound(字符串序列) '8
End Sub
Function 重复数组(重复词, 次数) '先准备参数，再调用函数
ReDim 列表(次数)
For i = 0 To 次数 - 1
列表(i) = 重复词
Next
重复数组 = 列表
End Function
Function 数组(个数) '带参数的函数
ReDim 列表(个数)
For i = 0 To 个数 - 1
列表(i) = i + 1
Next
数组 = 列表
End Function
用Application.run看看能不能提高效率
模型总结
循环（集合,操作）
操作
宏名
函数名
Application.Run 宏名, 元素
&Application.Run 函数名, 元素
模型代码存储
模块1
Application.Run相关研究
模块2
遍历区域单元格
模块3
调用word带参数宏
模块4
经常公用的宏
选中非空单元格
确定区域
选中最后一行
填写表单
模块5
遍历文件夹文件模型
创建文件夹对象
递归函数
遍历文件夹文件
积累系统
文件模块
wordvba研究.xlsm
作用是记录和整理代码
wordvba研究.emmx
作用是学习和优化整理
wordvba研究
作用是存储各个实验案例
wordvba学习资料
作用是存储学习资料
项目开发模板
文件模块
测试文件
作用是存储待处理文件
生成文件
作用是存储待生成文件
操作可视化模板.docm
作用是记录代码和编程流程
测试文件结构分析.docx
作用是分析文件结构
总结
开发流程
1. 打开此文件后，点击开发工具——设计模式——双击运行——可见代码 2. 文件和代码两个窗口可分屏，方便可视化 3. 主要流程是： （1）打开文件，1次即可； （2）运行文件，每次都用到； （3）编写主要是Call xxx，编写好一个版本就保存为xxx1，xxx 2等，保存版本再批量运行之后；
编程的原则
1. 先数据后操作，比如复制粘贴要放在后面集中处理，这样实验阶段可以提高效率 2. 用documents(f),少用activedocument,这样可以精准，少犯错 3. 出现的错误进行记录和总结，下次就找错就快了 4. 总结并更新模板，让下次更高效 5. 总结函数模型，编写函数高效，特别是循环类函数
编程的步骤
1分析试卷结构
2分析数据结构
3提取数据
4.解读数据
5编写代码
实验、代码记录、总结等于一体的设计方案
excelvba
xlsm文件
项目管理
生成所有表单链接
按钮：快速生成一个新表单和链接
项目列表-分类等
新建项目
有汇总链接
加一个按钮可以快速打开代码
其他sheet
有汇总链接
重命名为实验的名
实验2是带参数的函数，需要被调用
单元格里是测试数据等
加一个按钮可以快速打开代码
模块1
实验application.run
模块2
遍历区域单元格模型
模块3
调用word宏模型
模块4
选中非空单元格公用
更新系统模板
方案1
不要模块，都用sheet来记录代码
优点
方便复制和移动
自动生成初始代码和按钮
缺点
每次保存时弹窗
已解决
没有公共宏，调用时必须加模块
方案2
全部用模块
优点
导入模块并复制单个sheet就可以建立新系统
缺点
代码整理比较复杂，查找和更新不方便
每次保存时弹窗
已解决
方案3
表单
按钮和直接相关代码
模块
公共代码或模型
系统模型
放一些基础表单和模块即可
可以考虑多几个系统模型不同情况下使用
wordvba
xlsm文件
项目管理
新建项目
遍历选中单元格模型
复制模板文件（文件全名,新文件名）
链接到文件一句代码即可
项目和实验汇总
项目和实验模板.docm
暂存
操作模块
wordvba研究.xlsm
查找并分解考点
新建文件和保存文件
批量处理word
批量链接
编号查找与替换
字符串查找
去表格
知识点和练习题以及例题查找
讲义元素分解
批量修改题目
每日一练2
查找考点
CopyAddPastSave
find_Bold0
find_Bold
find
查找
sub function
选中
Selection
Start
选中内容.起始位置
End
选中内容.结尾位置
find
ClearFormatting
选中内容.查找.清楚格式
Text
选中内容.查找.内容
Font
Bold
选中内容.查找.格式.加粗
Found
判断是否找到了
位置
ActiveDocument
Content
End
文本.内容.结尾
逻辑语言
With End With
with 相当于省重复的部分
分解试卷
空
新建项目
汇总
实验案例
主函数
属性
存在状态
位置
方法
位置的生成
是否被吃
初始化
结束
word
对象\属性\方法\常用代码
Word.Application
创建
Set word对象 = CreateObject("Word.Application")
方法
run
documents
open
add
document
Paragraphs
ExportAsFixedFormat
range
方法
Copy
Cut
Delete
Paste
Select
ExportAsFixedFormat
ExportFragment
InsertAfter
InsertBefore
InsertFile
InsertBreak
AutoFormat
Calculate
CheckGrammar
CheckSpelling
CheckSynonyms
Collapse
ComputeStatistics
ConvertHangulAndHanja
ConvertToTable
CopyAsPicture
DetectLanguage
EndOf
Expand
GetSpellingSuggestions
GoTo
GoToEditableRange
GoToNext
GoToPrevious
ImportFragment
InRange
InsertAlignmentTab
InsertAutoText
InsertCaption
InsertCrossReference
InsertDatabase
InsertDateTime
InsertParagraph
InsertParagraphAfter
InsertParagraphBefore
InsertSymbol
InsertXML
InStory
IsEqual
LookupNameProperties
ModifyEnclosure
Move
MoveEnd
MoveEndUntil
MoveEndWhile
MoveStart
MoveStartUntil
MoveStartWhile
MoveUntil
MoveWhile
Next
NextSubdocument
PasteAndFormat
PasteAppendTable
PasteAsNestedTable
PasteExcelTable
PasteSpecial
PhoneticGuide
Previous
PreviousSubdocument
Relocate
SetListLevel
SetRange
Sort
SortAscending
SortDescending
StartOf
TCSCConverter
WholeStory
属性
Application Bold BoldBi Document End Find Font Hyperlinks Sections Sentences Start Text Cells Characters Columns Parent Rows Words ShapeRange StoryLength StoryType Style BookmarkID Bookmarks Borders Case CharacterStyle CharacterWidth CombineCharacters Comments Conflicts ContentControls Creator DisableCharacterSpaceGrid Duplicate Editors EmphasisMark EndnoteOptions Endnotes EnhMetaFileBits Fields FitTextWidth FootnoteOptions Footnotes FormattedText FormFields Frames GrammarChecked GrammaticalErrors HighlightColorIndex HorizontalInVertical HTMLDivisions ID Information InlineShapes IsEndOfRowMark Italic ItalicBi Kana LanguageDetected LanguageID LanguageIDFarEast LanguageIDOther ListFormat ListParagraphs ListStyle Locks NextStoryRange NoProofing OMaths Orientation PageSetup ParagraphFormat Paragraphs ParagraphStyle ParentContentControl PreviousBookmarkID ReadabilityStatistics Revisions Scripts Shading ShowAll SpellingChecked SpellingErrors Subdocuments SynonymInfo Tables TableStyle TextRetrievalMode TopLevelTables TwoLinesInOne Underline Updates WordOpenXML XML XMLNodes XMLParentNode
Filedialog
创建
set 对话框=Application.FileDialog(fileDialogType)
MsoFileDialogType 可为以下 MsoFileDialogType 常量之一。msoFileDialogFilePicker 允许用户选择一个文件。 msoFileDialogFolderPicker 允许用户选择一个文件夹。 msoFileDialogOpen 允许用户打开一个文件。 msoFileDialogSaveAs 允许用户保存一个文件。
filedialog
方法 名称 说明  Execute 在调用 Show 方法后立即执行用户的操作。  Show 显示文件对话框并返回一个 Long 类型的值，指示用户按下的是“操作”按钮 (-1) 还是“取消”按钮 (0)。在调用 Show 方法时，在用户关闭文件对话框之前不会执行其他代码。在“打开”和“另存为”对话框中，在使用了 Show 方法后会立即使用 Execute 方法执行用户操作。 属性 名称 说明  AllowMultiSelect 如果允许用户从文件对话框中选择多个文件，则为 True。可读/写。  Application 获取一个 Application 对象，代表 FileDialog 对象的容器应用程序（可以使用 Automation 对象的此属性返回该对象的容器应用程序）。只读。  ButtonName 设置或获取代表文件对话框中动作按钮上所显示文本的 String 类型的值。可读/写。  Creator 获取一个 32 位整数，指示创建 FileDialog 对象时所使用的应用程序。只读。  DialogType 返回一个 MsoFileDialogType 常量，代表 FileDialog 对象被设置为要显示的文件对话框的类型。只读。  FilterIndex 获取或设置一个 Long 类型的值，指示文件对话框的默认文件筛选器。默认筛选器决定首次打开文件对话框时显示的文件类型。可读/写。  Filters 获取一个 FileDialogFilters 集合。只读。  InitialFileName 设置或返回一个 String 类型的值，代表文件对话框中初始显示的路径或文件名。可读/写。  InitialView 获取或设置一个 MsoFileDialogView 常量，代表文件对话框中文件和文件夹的初始表示形式。可读/写。  Item 获取与对象关联的文本。只读。  Parent 获取 FileDialog 对象的 Parent 对象。只读。  SelectedItems 获取一个 FileDialogSelectedItems 集合。此集合包含用户在使用 FileDialog 对象的 Show 方法显示的文件对话框中所选的文件的路径列表。只读。  Title 设置或获取使用 FileDialog 对象显示的文件对话框的标题。可读/写。
提供文件对话框，其功能与 Microsoft Office 应用程序中标准的“打开”和“保存”对话框类似。 说明 使用 FileDialog 属性返回一个 FileDialog 对象。FileDialog 属性位于每个单独 Office 应用程序的 Application 对象中。该属性使用一个参数 DialogType 确定该属性返回的 FileDialog 对象类型。FileDialog 对象有四种类型： “打开”对话框 - 允许用户选择一个或多个可以在宿主应用程序中使用 Execute 方法打开的文件。 “另存为”对话框 - 允许用户选择一个文件，然后可以使用 Execute 方法将当前文件另存为该文件。 “文件选取器”对话框 - 允许用户选择一个或多个文件。用户选择的文件路径将捕获到 FileDialogSelectedItems 集合中。 “文件夹选取器”对话框 - 允许用户选择一个路径。用户选择的路径将捕获到 FileDialogSelectedItems 集合中。 每个宿主应用程序只能创建一个 FileDialog 对象实例。因此，即使创建多个 FileDialog 对象，FileDialog 对象的很多属性也会保持不变。所以，在显示对话框之前请确保已经针对用途适当地设置了所有属性。
Application.FileDialog
返回一个 FileDialog 对象，该对象表示文件对话框的实例。 语法 表达式.FileDialog(fileDialogType) 表达式 一个代表 Application 对象的变量。 参数 名称 必选/可选 数据类型 说明 fileDialogType 必选 MsoFileDialogType 文件对话框的类型。 说明 MsoFileDialogType 可为以下 MsoFileDialogType 常量之一。 msoFileDialogFilePicker 允许用户选择一个文件。 msoFileDialogFolderPicker 允许用户选择一个文件夹。 msoFileDialogOpen 允许用户打开一个文件。 msoFileDialogSaveAs 允许用户保存一个文件。 示例 在本示例中，Microsoft Excel 打开文件对话框，允许用户选择一个或多个文件。选中这些文件之后，Excel 将逐条显示每个文件的路径。 Visual Basic for Applications Sub UseFileDialogOpen() Dim lngCount As Long ' Open the file dialog With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show ' Display paths of each file selected For lngCount = 1 To .SelectedItems.Count MsgBox .SelectedItems(lngCount) Next lngCount End With End Sub
Excel.Application
创建
Workbooks
Workbook
Worksheets
方法 Add Add2 Copy Delete FillAcrossSheets Move PrintOut PrintPreview Select 属性 应用程序 Count Creator HPageBreaks Item Parent Visible VPageBreaks
Worksheet
活动 Activate BeforeDelete BeforeDoubleClick BeforeRightClick Calculate Change Deactivate FollowHyperlink LensGalleryRenderComplete PivotTableAfterValueChange PivotTableBeforeAllocateChanges PivotTableBeforeCommitChanges PivotTableBeforeDiscardChanges PivotTableChangeSync PivotTableUpdate SelectionChange TableUpdate 方法 Activate Calculate ChartObjects CheckSpelling CircleInvalid ClearArrows ClearCircles Copy 删除 Evaluate ExportAsFixedFormat Move OLEObjects Paste PasteSpecial PivotTables PivotTableWizard PrintOut PrintPreview Protect ResetAllPageBreaks SaveAs Scenarios Select SetBackgroundPicture ShowAllData ShowDataForm Unprotect XmlDataQuery XmlMapQuery 属性 应用程序 AutoFilter AutoFilterMode Cells CircularReference CodeName 列 备注 CommentsThreaded ConsolidationFunction ConsolidationOptions ConsolidationSources Creator CustomProperties DisplayPageBreaks DisplayRightToLeft EnableAutoFilter EnableCalculation EnableFormatConditionsCalculation EnableOutlining EnablePivotTable EnableSelection FilterMode HPageBreaks Hyperlinks 索引 ListObjects MailEnvelope 名称 Names Next Outline PageSetup Parent Previous PrintedCommentPages ProtectContents ProtectDrawingObjects 保护 ProtectionMode ProtectScenarios QueryTables Range Rows ScrollArea Shapes Sort StandardHeight StandardWidth Tab TransitionExpEval TransitionFormEntry 类型 UsedRange Visible VPageBreaks
Filedialog
创建
range
创建
Set 头 = ActiveSheet.Cells(2, 1)
Set 尾 = ActiveSheet.Cells(2, 1000)
Set 区域 = ActiveSheet.Range(头, 尾)
Function
Function 确定区域(a, b, c, d) '从a行b列到c行d列的区域
Set 头 = ActiveSheet.Cells(a, b)
Set 尾 = ActiveSheet.Cells(c, d)
Set 确定区域 = ActiveSheet.Range(头, 尾) '参数
End Function
方法
find
Set 返回单元格 = 区域.Find(“查找内容”)
单元格.MergeArea
单元格所在合并区域
单元格.MergeArea.cells.count
单元格所在合并区域单元格个数
Select
区域.Select
copy
paste
Merge
属性
MergeCells
MergeArea
cells
count
研究
方法 名称 说明 Activate 激活单个单元格，该单元格必须处于当前选定区域内。要选择单元格区域，请使用 Select 方法。 AddComment 为区域添加批注。 AdvancedFilter 基于条件区域从列表中筛选或复制数据。如果初始选定区域为单个单元格，则使用单元格的当前区域。 AllocateChanges 在基于 OLAP 数据源的区域中的所有已编辑的单元格上执行回写操作。 ApplyNames 将名称应用于指定区域中的单元格。 ApplyOutlineStyles 对指定区域应用分级显示样式。 AutoComplete 从列表中返回一个记忆式键入匹配项。如果没有相应的记忆式键入匹配项，或者在列表中有不止一个与已键入字符串相匹配的项，此方法将返回一空字符串。 AutoFill 对指定区域中的单元格执行自动填充。 AutoFilter 使用“自动筛选”筛选一个列表。 AutoFit 更改区域中的列宽或行高以达到最佳匹配。 AutoOutline 自动为指定区域创建分级显示。如果区域为单个单元格，Microsoft Excel 将创建整个工作表的分级显示。新分级显示将取代所有的分级显示。 BorderAround 向单元格区域添加边框，并设置该新边框的 Color、LineStyle 和 Weight 属性。Variant。 Calculate 计算所有打开的工作簿、工作簿中的某张特定工作表或工作表指定区域中的单元格，如下表所示。 CalculateRowMajorOrder 计算指定的单元格区域。 CheckSpelling 检查对象的拼写。 Clear 清除整个对象。 ClearComments 清除指定区域的所有单元格批注。 ClearContents 清除指定区域的公式。 ClearFormats 清除对象的格式设置。 ClearHyperlinks 删除指定区域中的所有超链接。 ClearNotes 清除指定区域中所有单元格的批注和语音批注。 ClearOutline 清除指定区域的分级显示。 ColumnDifferences 返回一个 Range 对象，该对象代表各列中其内容与比较单元格不同的单元格。 Consolidate 将多个工作表中多个区域的数据合并计算至单个工作表上的单个区域。Variant 类型。 Copy 将单元格区域复制到指定的区域或剪贴板中。 CopyFromRecordset 将 ADO 或 DAO Recordset 对象中的内容复制到工作表，从指定区域的左上角开始。如果 Recordset 对象包含具有 OLE 对象的字段，则该方法无效。 CopyPicture 将所选对象作为图片复制到剪贴板。Variant。 CreateNames 在指定区域中依据工作表中的文本标签创建名称。 Cut 将对象剪切到剪贴板，或者将其粘贴到指定的目的地。 DataSeries 在指定区域内创建数据系列。Variant 类型。 Delete 删除对象。 DialogBox 显示由 Microsoft Excel 4.0 宏工作表上的对话框定义表所定义的对话框。返回选定控件的编号，或者当用户单击“取消”按钮时返回 False。 Dirty 下一次重新计算发生时指定要重新计算的区域。 DiscardChanges 放弃对该区域的已编辑的单元格的所有更改。 EditionOptions 您查询的是 Macintosh 专用的 Visual Basic 关键词。有关该关键词的帮助信息，请查阅 Microsoft Office Macintosh 版的语言参考帮助。 ExportAsFixedFormat 导出为指定格式的文件。 FillDown 从指定区域的顶部单元格开始向下填充，直至该区域的底部。区域中首行单元格的内容和格式将复制到区域中其他行内。 FillLeft 从指定区域的最右边单元格开始向左填充。区域中最右列单元格的内容和格式将复制到区域中其他列内。 FillRight 从指定区域的最左边单元格开始向右填充。区域中最左列单元格的内容和格式将复制到区域中其他列内。 FillUp 从指定区域的底部单元格开始向上填充，直至该区域的顶部。区域中尾行单元格的内容和格式将复制到区域中其他行内。 Find 在区域中查找特定信息。 FindNext 继续由 Find 方法开始的搜索。查找匹配相同条件的下一个单元格，并返回表示该单元格的 Range 对象。该操作不影响选定内容和活动单元格。 FindPrevious 继续由 Find 方法开始的搜索。查找匹配相同条件的上一个单元格，并返回代表该单元格的 Range 对象。该操作不影响选定内容和活动单元格。 FunctionWizard 对指定区域左上角单元格启动“函数向导”。 Group 当 Range 对象代表某个数据透视表字段的数据区域中的单个单元格时，Group 方法在该字段中执行基于数字或日期的分组。 Insert 在工作表或宏表中插入一个单元格或单元格区域，其他单元格相应移位以腾出空间。 InsertIndent 向指定的区域添加缩进量。 Justify 调整区域内的文字，使之均衡地填充该区域。 ListNames 从指定区域的第一个单元格位置开始，将所有未隐藏的名称的列表粘贴到工作表上。 Merge 由指定的 Range 对象创建合并单元格。 NavigateArrow 定位追踪箭头，此箭头指定引用单元格、从属单元格或错误源单元格。选定引用单元格、从属单元格或错误源单元格并返回一个 Range 对象，该对象代表新选定区域。本方法应用于没有可见追踪箭头的单元格时将出错。 NoteText 返回或设置与区域左上角单元格相关联的单元格注释。String 类型，可读写。单元格注释已经替换为区域注释。有关详细信息，请参阅 Comment 对象。 Parse 分列区域内的数据并将这些数据分散放置于若干单元格中。将区域内容分配于多个相邻接的列中；该区域只能包含一列。 PasteSpecial 将 Range 从剪贴板粘贴到指定的区域中。 PrintOut 打印对象。 PrintPreview 按对象打印后的外观效果显示对象的预览。 RemoveDuplicates 从值区域中删除重复的值。 RemoveSubtotal 删除列表中的分类汇总。 Replace 返回 Boolean，它表示指定区域内单元格中的字符。使用此方法并不会更改选定区域或活动单元格。 RowDifferences 返回一个 Range 对象，该对象代表各行中其内容与比较单元格不同的所有单元格。 Run 在该处运行 Microsoft Excel 宏。区域必须位于宏表上。 Select 选择对象。 SetPhonetic 为指定区域中的所有单元格创建 Phonetic 对象。 Show 滚动当前活动窗口中的内容以将指定区域移到视图中。此区域必须由活动文档中的单个单元格组成。 ShowDependents 绘制从指定区域指向直接从属单元格的追踪箭头。 ShowErrors 绘制通过从属单元格树而指向错误源单元格的追踪箭头，并返回包含该单元格的区域。 ShowPrecedents 绘制从指定区域指向直接引用单元格的追踪箭头。 Sort 对值区域进行排序。 SortSpecial 使用东亚排序方法对区域或数据透视表进行排序；或者如果区域中只包含一个单元格，则对活动区域使用本方法。例如，日文排序方法是按照假名音节表进行排序的。 Speak 按行或列的顺序朗读单元格区域。 SpecialCells 返回一个 Range 对象，该对象代表与指定类型和值匹配的所有单元格。 SubscribeTo 您查询的是 Macintosh 专用的 Visual Basic 关键词。有关该关键词的帮助信息，请查阅 Microsoft Office Macintosh 版的语言参考帮助。 Subtotal 创建指定区域或当前区域（如果该区域为单个单元格时）的分类汇总。 Table 依据输入值和工作表上定义的公式创建模拟运算表。 TextToColumns 将包含文本的一列单元格分解为若干列。 Ungroup 在分级显示中对一个区域进行升级（即降低其分级显示的级别）。指定区域必须是行或列，或者行区域或列区域。如果指定区域在数据透视表中，本方法将对该区域内的项取消分组。 UnMerge 将合并区域分解为独立的单元格。 属性 名称 说明 AddIndent 返回或设置一个 Variant 值，它指明当单元格中文本的对齐方式为水平或垂直等距分布时，文本是否为自动缩进。 Address 返回一个 String 值，它代表宏语言的区域引用。 AddressLocal 以用户语言返回对指定区域的区域引用。String 类型，只读。 AllowEdit 返回一个 Boolean 值，它指明是否可以在受保护的工作表上编辑区域。 Application 如果不使用对象识别符，则该属性返回一个代表 Microsoft Excel 应用程序的 Application 对象。如果使用对象识别符，则该属性返回一个代表指定对象的创建程序的 Application 对象（可对一个 OLE 自动化对象使用该属性来返回该对象的应用程序）。只读。 Areas 返回一个 Areas 集合，该集合代表多区域选定内容中的所有区域。只读。 Borders 返回一个 Borders 集合，该集合代表样式或单元格区域（包括定义为条件格式的一部分的区域）的边框。 Cells 返回一个 Range 对象，该对象代表指定区域中的单元格。 Characters 返回一个 Characters 对象，它代表对象文本内的字符区域。使用 Characters 对象可为文本字符串内的字符设置格式。 Column 返回指定区域中第一块中的第一列的列号。Long 类型，只读。 Columns 返回一个 Range 对象，该对象代表指定区域中的列。 ColumnWidth 返回或设置指定区域中所有列的列宽。Variant 类型，可读写。 Comment 返回一个 Comment 对象，该对象代表与区域左上角中的单元格关联的注释。 Count 返回一个 Long 值，它代表集合中对象的数量。 CountLarge 在指定区域的值中计算最大值。只读 Variant 类型。 Creator 返回一个 32 位整数，该整数指示创建对象的应用程序。只读 Long 类型。 CurrentArray 如果指定单元格属于数组，则返回一个 Range 对象，该对象表示整个数组。只读。 CurrentRegion 返回一个 Range 对象，该对象代表当前区域。当前区域是由空行和空列的任意组合所限定的区域。只读。 Dependents 返回一个 Range 对象，该对象代表包含某个单元格的所有从属单元格的区域。如果有多个从属单元格，则这可以是多个选定内容（Range 对象的联合）。只读 Range 对象。 DirectDependents 返回一个 Range 对象，该对象代表包含某个单元格的所有直接从属单元格的区域。如果有多个从属单元格，则这可以是多个选定内容（Range 对象的联合）。只读 Range 对象。 DirectPrecedents 返回一个 Range 对象，该对象代表包含某个单元格的所有直接引用单元格的区域。如果有多个引用单元格，则这可以是多个选定内容（Range 对象的联合）。只读 Range 对象。 DisplayFormat 返回一个 DisplayFormat 对象，该对象代表指定区域的显示设置。只读。 End 返回一个 Range 对象，该对象代表包含源区域的区域末尾的单元格。等同于按 END + 向上键、END + 向下键、END + 向左键或 END + 向右键。只读 Range 对象。 EntireColumn 返回一个 Range 对象，该对象代表包含指定区域的整列或多列。只读。 EntireRow 返回一个 Range 对象，该对象代表包含指定区域的整行或多行。只读。 Errors 允许用户访问错误检查选项。 Font 返回一个 Font 对象，它代表指定对象的字体。 FormatConditions 返回一个 FormatConditions 集合，该集合代表指定区域的所有条件格式。只读。 Formula 返回或设置一个 Variant 值，它代表 A1 样式表示法和宏语言中的对象的公式。 FormulaArray 返回或设置区域的数组公式。返回（或可设置为）单个公式或 Visual Basic 数组。如果指定区域不包含数组公式，则该属性返回 null。Variant 类型，可读写。 FormulaHidden 返回或设置一个 Variant 值，它指明在工作表处于保护状态时是否隐藏公式。 FormulaLocal 返回或设置对象的公式，使用用户语言 A1 格式引用。可读/写 Variant 类型。 FormulaR1C1 返回或设置对象的公式，使用宏语言 R1C1 格式符号表示。可读/写 Variant 类型。 FormulaR1C1Local 返回或设置对象的公式，使用用户语言 R1C1 格式符号表示。可读/写 Variant 类型。 HasArray 如果指定单元格属于数组公式，则该属性值为 True。Variant 类型，只读。 HasFormula 如果区域中所有单元格均包含公式，则该属性值为 True；如果所有单元格均不包含公式，则该属性值为 False；其他情况下为 null。Variant 类型，只读。 Height 返回或设置一个 Variant 值，该值代表区域的高度（以磅为单位）。 Hidden 返回或设置一个 Variant 值，它指明是否隐藏行或列。 HorizontalAlignment 返回或设置一个 Variant 值，它代表指定对象的水平对齐方式。 Hyperlinks 返回一个 Hyperlinks 集合，该集合代表区域的超链接。 ID 返回或设置一个 String 值，它代表将页面另存为网页时指定单元格的识别标志。 IndentLevel 返回或设置一个 Variant 值，它代表单元格或单元格区域的缩进量。可为 0 到 15 之间的整数。 Interior 返回一个 Interior 对象，它代表指定对象的内部。 Item 返回一个 Range 对象，该对象代表与指定区域存在一定偏移的区域。 Left 返回一个 Variant 值，它代表从列 A 的左边缘到区域的左边缘的距离（以磅为单位）。 ListHeaderRows 返回指定区域中标题行的数目。Long 类型，只读。 ListObject 返回 Range 对象的 ListObject 对象。只读 ListObject 对象。 LocationInTable 返回一个常量，该常量描述包含指定区域左上角部分的 PivotTable 部分。可为以下 XlLocationInTable 常量之一。Long 类型，只读。 Locked 返回或设置一个 Variant 值，它指明对象是否已被锁定。 MDX 返回指定的 Range 对象的 MDX 名称。只读 String 类型。 MergeArea 返回一个 Range 对象，该对象代表包含指定单元格的合并区域。如果指定的单元格不在合并区域内，则该属性返回指定的单元格。只读。Variant 类型。 MergeCells 如果区域包含合并单元格，则为 True。Variant 型，可读写。 Name 返回或设置一个 Variant 值，它代表对象的名称。 Next 返回一个 Range 对象，该对象代表下一个单元格。 NumberFormat 返回或设置一个 Variant 值，它代表对象的格式代码。 NumberFormatLocal 以采用用户语言字符串的形式返回或设置一个 Variant 值，它代表对象的格式代码。 Offset 返回一个 Range 对象，该对象代表与指定区域存在一定偏移的区域。 Orientation 返回或设置一个 Variant 值，它代表文本方向。 OutlineLevel 返回或设置指定行或列的当前分级显示级别。Variant 类型，可读写。 PageBreak 返回或设置分页符的位置。可为以下 XlPageBreak 常量之一：xlPageBreakAutomatic、xlPageBreakManual 或 xlPageBreakNone。Long 类型，可读写。 Parent 返回指定对象的父对象。只读。 Phonetic 返回 Phonetic 对象，该对象包含单元格中特定拼音文本字符串的相关信息。 Phonetics 返回区域的 Phonetics 集合。只读。 PivotCell 返回一个 PivotCell 对象，该对象代表数据透视表中的单元格。 PivotField 返回一个 PivotField 对象，该对象代表包含指定区域左上角的数据透视表字段。 PivotItem 返回一个 PivotItem 对象，该对象代表包含指定区域左上角的数据透视表项。 PivotTable 返回一个 PivotTable 对象，该对象代表包含指定区域左上角的数据透视表。 Precedents 返回一个 Range 对象，该对象代表单元格的所有引用单元格。如果有多个引用单元格，则这可以是多个选定内容（Range 对象的联合）。只读。 PrefixCharacter 返回单元格的前缀字符。Variant 类型，只读。 Previous 返回一个 Range 对象，该对象代表下一个单元格。 QueryTable 返回一个 QueryTable 对象，该对象代表与指定 Range 对象相交的查询表。 Range 返回一个 Range 对象，该对象代表单元格或单元格区域。 ReadingOrder 返回或设置指定对象的阅读次序。可为以下常量之一：xlRTL（从右到左）、xlLTR（从左到右）或 xlContext。Long 类型，可读写。 Resize 调整指定区域的大小。返回 Range 对象，该对象代表调整后的区域。 Row 返回区域中第一个子区域的第一行的行号。Long 类型，只读。 RowHeight 以磅 （磅：指打印的字符的高度的度量单位。1 磅等于 1/72 英寸，或大约等于 1 厘米的 1/28。）为单位返回或设置指定区域中所有行的行高。如果指定区域中的各行的行高不等，则返回 null。Variant 类型，可读写。 Rows 返回一个 Range 对象，该对象代表指定区域中的行。只读 Range 对象。 ServerActions 指定可在 SharePoint 服务器上对 Range 对象执行的操作。 ShowDetail 如果扩展了指定区域的分级显示（从而行或列的明细数据可见），则为 True。指定区域必须为分级显示中的单个汇总列或汇总行。Variant 型，可读写。对于 PivotItem 对象（如果该区域在数据透视表中，则为 Range 对象），当数据项显示明细数据时，此属性设为 True。 ShrinkToFit 返回或设置一个 Variant 值。 SoundNote 本属性不应再被使用。语音批注已从 Microsoft Excel 中删除。 SparklineGroups 返回一个 SparklineGroups 对象，该对象代表指定区域中的现有迷你图组。只读。 Style 返回或设置一个包含 Style 对象的 Variant 值，它代表指定区域的样式。 Summary 返回或设置与指定表的可选文本字符串关联的说明。可读写。 Text 返回或设置指定对象中的文本。String 型，只读。 Top 返回或设置一个 Variant 值，它代表行 1 上边缘到区域上边缘的距离（以磅为单位）。 UseStandardHeight 如果 Range 对象的行高等于工作表的标准行高，则该值为 True。如果区域包含不止一行并且不是所有的行都等高，则返回 Null。Variant 类型，可读写。 UseStandardWidth 如果 Range 对象的列宽等于工作表的标准列宽，则该属性的值为 True。如果区域包含不止一列并且不是所有的列都等宽，则返回 null。Variant 类型，可读写。 Validation 返回 Validation 对象，该对象代表指定区域的数据验证。只读。 Value 返回或设置一个 Variant 型，它代表指定单元格的值。 Value2 返回或设置单元格值。Variant 类型，可读写。 VerticalAlignment 返回或设置一个 Variant 值，它代表指定对象的垂直对齐方式。 Width 返回一个 Variant 值，它代表区域的宽度（以单位表示）。 Worksheet 返回一个 Worksheet 对象，该对象代表包含指定区域的工作表。只读。 WrapText 返回或设置一个 Variant 值，它指明 Microsoft Excel 是否为对象中的文本自动换行。 XPath 返回一个 XPath 对象，它代表映射到指定 Range 对象的元素的 Xpath。该区域的上下文确定操作是否成功，或返回空对象。只读。
单元格集cells
列
Column
行
Row
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range(Cells(第1列非空行 + 1, 3), Cells(第3列非空行, 3)).Select
ActiveSheet.Hyperlinks.Add 区域, "", "项目管理!A1", , "项目管理"
ActiveSheet.Hyperlinks.Add 区域, 文件路径及文件名
文件系统FileSystemObject
创建
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
属性
方法
BuildPath
文件系统.BuildPath("c:/", "文件夹/")
等价于
"c:/"+"文件夹/"
"c:/"&"文件夹/"
结论：此操作没有用，用其他方法更简单
CopyFile
将一个或多个文件从一个位置复制到另一个位置。
有待进一步学习和研究
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
Set 文件夹对象 = 文件系统.GetFile(FilePath)
文件夹对象.Copy 新文件名
文件夹Folder
创建
Set 文件夹对象 = 文件系统.GetFolder(FolderPath)
属性
子文件夹集SubFolders
创建
Set 子文件夹集 = 文件夹对象.SubFolders
遍历
For Each 子文件夹 In 子文件夹集
文件集Files
创建
Set 文件集 = 文件夹.Files
Set 文件集 = 子文件夹.Files
遍历
For Each 文件 In 文件集
文件File
创建
Set 文件夹对象 = 文件系统.GetFile(FilePath)
Scripting.FileSystemObject
GetFolder
Folders
Folder
Files
方法 方法 方法 说明 复制 将指定文件从一个位置复制到另一个位置。 删除 删除指定文件。 Move 将指定文件从一个位置移动到另一个位置。 OpenAsTextStream 打开指定的文件并返回 一个 TextStream 对象以访问该文件。 属性 属性 属性 说明 Attributes 设置或返回指定文件的属性。 DateCreated 返回创建指定文件的日期和时间。 DateLastAccessed 返回上次访问指定文件的日期和时间。 DateLastModified 返回上次修改指定文件的日期和时间。 Drive 返回指定文件或文件夹所在的驱动器的驱动器号。 名称 设置或返回指定文件的名称。 ParentFolder 返回指定文件的父文件夹对象。 Path 返回指定文件的路径。 ShortName 返回指定文件的短名称， (8.3 命名约定) 。 ShortPath 返回指定文件的短路径 (8.3 命名约定) 。 大小 返回指定文件的大小（以字节为单位）。 类型 返回指定文件的类型。
filedialog
函数及关键字
数组
作用 关键字 确认一个数组。 IsArray 建立一个数组。 Array 改变缺省最小值。 Option Base 声明及初始化数组。 Dim, Private, Public, ReDim, Static 判断数组下标极限值。 LBound, UBound 重新初始化一个数组。 Erase, ReDim
时间及日期
获取当前日期或时间
Date
今天日期
Now
现在时间
Time
现在日期和时间
转化
日期转成序列号
DateSerial
指定年月日
DateValue
生成年月日序列
日期转成天、月、星期或年。
Year
Month
Day
Weekday
时间转成小时、分钟或秒。
Hour
Minute
Second
时间转成序列号。
TimeSerial
指定时分秒
TimeValue
生成时分秒序列
timer
GetObject
CreateObject
application
Application.Run 方法 运行 Visual Basic 宏。 语法 表达式.Run(MacroName, varg1, varg2, varg3, varg4, varg5, varg6, varg7, varg8, varg9, varg10, varg11, varg12, varg13, varg14, varg15, varg16, varg17, varg18, varg19, varg20, varg21, varg22, varg23, varg24, varg25, varg26, varg27, varg28, varg29, varg30) 表达式 必选。一个代表 Application 对象的变量。 参数 名称 必选/可选 数据类型 说明 MacroName 必选 String 宏的名称。 varg1...varg30 可选 Variant 宏参数值。最多可以给指定宏传递 30 个参数值。 说明 MacroName 参数可以是任意模板、模块和宏名的组合。例如，下列语句均有效。 Visual Basic for Applications Application.Run "Normal.Module1.MAIN" Application.Run "MyProject.MyModule.MyProcedure" Application.Run "'My Document.doc'!ThisModule.ThisProcedure" 如果指定了文档名，则此代码只能运行与当前环境有关的文档中的宏，而不是任何文档中的任何宏。 虽然 Visual Basic 代码可直接调用宏（无需使用 Run 方法），但当宏名存储在变量中时该方法仍很有用。（有关详细信息，请参见本主题示例。）下面三条语句作用相同。前两条语句需要引用 Normal.dot（被调用宏所在的项目）；第三条语句由于使用 Run 方法，因此无需引用 Normal.dot 项目。 Visual Basic for Applications Normal.Module2.Macro1 Call Normal.Module2.Macro1 Application.Run MacroName:="Normal.Module2.Macro1" 示例 本示例提示用户输入模板名、模块名、宏名以及参数值，然后运行该宏。 Visual Basic for Applications Dim strTemplate As String Dim strModule As String Dim strMacro As String Dim strParameter As String strTemplate = InputBox("Enter the template name") strModule = InputBox("Enter the module name") strMacro = InputBox("Enter the macro name") strParameter = InputBox("Enter a parameter value") Application.Run MacroName:=strTemplate & "." _ & strModule & "." & strMacro, _ varg1:=strParameter © 2010 Microsoft Corporation。保留所有权利。 请参阅 Application 对象 Application 对象成员
控件
ActiveSheet.Shapes
方法 名称 说明  AddCallout 创建一个无边框的线形标注。返回一个代表新标注的 Shape 对象。  AddChart 在活动工作表上的指定位置创建图表。  AddConnector 创建一个连接符。返回一个代表新连接符的 Shape 对象。添加一个连接符时，它没有连接到任何对象。使用 BeginConnect 和 EndConnect 方法可将连接符的头和尾连接到文档中的其他形状上。  AddCurve 返回一个 Shape 对象，该对象代表工作表中的贝塞尔曲线。  AddFormControl 创建一个 Microsoft Excel 控件 （Microsoft Excel 控件：Excel 本身具有的控件，而不是 ActiveX 控件。）。将返回一个 Shape 对象，该对象代表新建的控件。  AddLabel 创建一个连接符。返回一个代表新连接符的 Shape 对象。  AddLine 当本方法应用于 Shapes 对象时，返回一个 Shape 对象，该对象表示工作表中的新线条。  AddOLEObject 创建 OLE 对象。返回一个代表新 OLE 对象的 Shape 对象。  AddPicture 现有文件创建图片。返回一个代表新图片的 Shape 对象。  AddPolyline 创建一个不封闭的连续线段或一个封闭的多边形。返回一个代表新的连续线段或多边形的 Shape 对象。  AddShape 返回一个 Shape 对象，该对象代表工作表中的新自选图形。  AddSmartArt 使用指定布局创建新 SmartArt 图形。  AddTextbox 创建一个文本框。返回一个代表新文本框的 Shape 对象。  AddTextEffect 创建艺术字对象。返回一个代表新艺术字对象的 Shape 对象。  BuildFreeform 建立一个任意多边形对象。返回一个 FreeformBuilder 对象，该对象代表正在创建的任意多边形。用 AddNodes 方法向任意多边形添加线段。如果任意多边形中已包含了一个以上的线段，则可用 ConvertToShape 方法将 FreeformBuilder 对象转换为 Shape 对象，该对象将具有在 FreeformBuilder 对象中定义的几何属性。  Item 从集合中返回一个对象。  SelectAll 选择指定的 Shapes 集合中的所有形状。 属性 名称 说明  Application 如果不使用对象识别符，则该属性返回一个代表 Microsoft Excel 应用程序的 Application 对象。如果使用对象识别符，则该属性返回一个代表指定对象的创建程序的 Application 对象（可对一个 OLE 自动化对象使用该属性来返回该对象的应用程序）。只读。  Count 返回一个 Long 值，它代表集合中对象的数量。  Creator 返回一个 32 位整数，该整数指示创建对象的应用程序。只读 Long 类型。  Parent 返回指定对象的父对象。只读。  Range 返回一个 ShapeRange 对象，该对象代表 Shapes 集合中形状的子集。
shape
方法 名称 说明  Apply 应用通过 PickUp 方法复制的指定形状格式。  Copy 将对象复制到剪贴板。  CopyPicture 将所选对象作为图片复制到剪贴板。  Cut 将对象剪切到剪贴板。  Delete 删除对象。  Duplicate 复制对象，并返回对新复制对象的引用。  Flip 绕指定形状的水平或垂直对称轴翻转该形状。  IncrementLeft 将指定形状水平移动指定的磅数。  IncrementRotation 使指定的形状按指定度数值绕 Z 轴旋转。使用 Rotation 属性可设置形状的绝对转角。  IncrementTop 以指定点数垂直移动指定形状。  PickUp 复制指定形状的格式。使用 Apply 方法可将复制的格式应用到其他形状。  RerouteConnections 此方法将重排连接在指定形状上的所有连接符；如果指定的形状是连接符，就重排该连接符。  ScaleHeight 按指定的比例调整形状的高度。对于图片和 OLE 对象，可以指定是相对于原有尺寸还是相对于当前尺寸来调整该形状。对于不是图片和 OLE 对象的形状，总是相对于其当前大小来调整高度。  ScaleWidth 按指定的比例调整形状的宽度。对于图片和 OLE 对象，可以指定是相对于原有尺寸还是相对于当前尺寸来调整该形状。对于不是图片和 OLE 对象的形状，总是相对于其当前大小来调整宽度。  Select 选择对象。  SetShapesDefaultProperties 将指定形状的格式设置为形状的默认格式。  Ungroup 取消指定形状或者形状区域中组合形状的组合。取消指定形状或形状区域中图片和 OLE 对象的组合。  ZOrder 将指定的形状移到集合中其他形状的前面或后面（即更改该形状在 Z 顺序中的位置）。 属性 名称 说明  Adjustments 返回一个 Adjustments 对象，该对象包含指定形状中所有调整的调整值。应用于任何代表自选图形、艺术字或连接符的 Shape 对象。  AlternativeText 返回或设置一个当 Shape 对象保存为网页时，该对象的描述性（可选）文本字符串。String 型，可读写。  Application 如果不使用对象识别符，则该属性返回一个代表 Microsoft Excel 应用程序的 Application 对象。如果使用对象识别符，则该属性返回一个代表指定对象的创建程序的 Application 对象（可对一个 OLE 自动化对象使用该属性来返回该对象的应用程序）。只读。  AutoShapeType 返回或设置指定的 Shape 或 ShapeRange 对象的形状类型，该对象必须代表自选图形，而不能代表直线、任意多边形图形或连接符。MsoAutoShapeType 类型，可读写。  BackgroundStyle 返回或设置背景样式。可读/写 MsoBackgroundStyleIndex 类型。  BlackWhiteMode 返回或设置一个值，该值指明以黑白模式查看演示文稿时指定形状出现的方式。MsoBlackWhiteMode，可读写。  BottomRightCell 返回一个 Range 对象，它代表对象右下角的单元格。只读。  Callout 返回一个 CalloutFormat 对象，该对象包含指定形状的标注格式属性。应用于代表线形标注的 Shape 对象。只读。  Chart 返回一个 Chart 对象，该对象代表形状中包含的图表。只读。  Child 如果指定的形状是子形状，或者如果形状区域中的所有形状都是同一个父形状的子形状，则返回 msoTrue。MsoTriState 类型，只读。  ConnectionSiteCount 返回指定形状中的连接部位的数量。Long 型，只读。  Connector 如果指定的形状是连接符，则此属性为 True。MsoTriState 类型，只读。  ConnectorFormat 返回一个 ConnectorFormat 对象，该对象包含连接符格式属性。应用于代表连接符的 Shape。只读。  ControlFormat 返回一个 ControlFormat 对象，该对象包含 Microsoft Excel 控件 （Microsoft Excel 控件：Excel 本身具有的控件，而不是 ActiveX 控件。）属性。只读。  Creator 返回一个 32 位整数，该整数指示创建对象的应用程序。只读 Long 类型。  Fill 为指定形状返回一个 FillFormat 对象，或为指定图表返回一个 ChartFillFormat 对象，该对象中包含形状或图表的填充格式属性。只读。  FormControlType 返回 Microsoft Excel 控件 （Microsoft Excel 控件：Excel 本身具有的控件，而不是 ActiveX 控件。）类型。XlFormControl 类型，只读。  Glow 为指定形状返回一个 GlowFormat 对象，该对象包含形状发光格式属性。只读。  GroupItems 返回一个 GroupShapes 对象，该对象代表指定形状组中的单个形状。使用 GroupShapes 对象的 Item 方法可从形状组中返回单个形状。应用于代表分组形状的 Shape 对象。只读。  HasChart 返回形状是否包含图表。MsoTriState 类型，只读。  HasSmartArt 返回指定形状上是否存在 SmartArt 图表。只读。  Height 返回或设置一个 Single 值，它代表对象的高度（以磅为单位）。  HorizontalFlip 如果指定的形状绕水平对称轴翻转，则为 True。MsoTriState，只读。  Hyperlink 返回一个 Hyperlink 对象，该对象代表形状的超链接。  ID 返回一个 Long 值，它代表指定对象的类型。  Left 返回或设置 Single 值，它代表从对象左边缘到工作表的 A 列左边缘或到图表上的图表区左边缘的距离（以磅为单位）。  Line 返回一个 LineFormat 对象，该对象包含指定形状的线条格式属性。（对于线条，LineFormat 对象代表线条本身；而对于具有边框的形状，LineFormat 对象代表边框）。只读。  LinkFormat 返回一个 LinkFormat 对象，该对象包含链接的 OLE 对象属性。只读。  LockAspectRatio 如果指定的形状在调整大小时其原始比例保持不变，则此属性为 True。如果调整大小时可以分别更改形状的高度和宽度，则此属性为 False。MsoTriState 类型，可读写。  Locked 返回或设置一个 Boolean 值，它指明对象是否已被锁定。  Name 返回或设置一个 String 值，它代表对象的名称。  Nodes 返回一个 ShapeNodes 集合，该集合代表指定形状的几何描述。  OLEFormat 返回一个 OLEFormat 对象，该对象包含 OLE 对象属性。只读。  OnAction 返回或设置单击指定对象时运行的宏的名称。String 类型，可读写。  Parent 返回指定对象的父对象。只读。  ParentGroup 返回一个 Shape 对象，该对象代表子形状或子形状区域的通用父形状。  PictureFormat 返回一个 PictureFormat 对象，该对象包含指定形状的图片格式属性。应用于代表图片或 OLE 对象的 Shape 对象。只读。  Placement 返回或设置一个 XlPlacement 值，该值代表将对象附加到该对象下方的单元格的方法。  Reflection 为指定形状返回一个 ReflectionFormat 对象，该对象包含形状的映像格式属性。只读。  Rotation 返回或设形状的旋转角度（以度为单位）。Single 型，可读写。  Shadow 返回一个只读的 ShadowFormat 对象，它包含指定形状的阴影格式属性。  ShapeStyle 返回或设置一个 MsoShapeStyleIndex，它代表形状区域的形状样式。可读写。  SmartArt 返回一个对象，该对象代表与形状关联的 SmartArt。只读。  SoftEdge 为指定形状返回一个 SoftEdgeFormat 对象，该对象包含形状的柔化边缘格式属性。只读。  TextEffect 返回一个 TextEffectFormat 对象，该对象包含指定形状的文本效果格式属性。只读。  TextFrame 返回一个 TextFrame 对象，该对象包含指定形状的对齐方式和定位属性。只读。  TextFrame2 返回一个 TextFrame2 对象，该对象包含指定形状的文本格式。只读。  ThreeD 返回一个 ThreeDFormat 对象，该对象包含指定形状的三维效果格式属性。只读。  Title 返回或设置与指定形状关联的可选文本的标题。可读写。  Top 返回或设置一个 Single 值，它代表形状范围内最上面的形状的上边缘到工作表上边缘的距离（以磅为单位）。  TopLeftCell 返回一个 Range 对象，它代表指定对象左上角的单元格。只读。  Type 返回或设置一个 MsoShapeType 值，该值代表形状类型。  VerticalFlip 如果指定的形状绕垂直坐标轴翻转，则此属性为 True。MsoTriState 类型，只读。  Vertices 将指定任意多边形形状的顶点（及贝塞尔曲线的控制点）坐标作为一系列坐标对 （坐标对：一对值，表示两维数组中存储的点的 x 和 y 坐标，该数组中包含许多点的坐标。）返回。可将此属性返回的数组用作 AddCurve 方法或 AddPolyLine 方法的参数。Variant 型，只读。  Visible 返回或设置一个 MsoTriState 值，它确定对象是否可见。可读写。  Width 返回或设置一个 Single 值，它代表对象的宽度（以磅为单位）。  ZOrderPosition 返回指定形状在 z-顺序中的位置。Long 型，只读。
宏
AddIn
属性 名称 说明  Application 如果不使用对象识别符，则该属性返回一个代表 Microsoft Excel 应用程序的 Application 对象。如果使用对象识别符，则该属性返回一个代表指定对象的创建程序的 Application 对象（可对一个 OLE 自动化对象使用该属性来返回该对象的应用程序）。只读。  CLSID 返回一个只读的唯一标识符，或识别对象的 CLSID。String 类型。  Creator 返回一个 32 位整数，该整数指示创建对象的应用程序。只读 Long 类型。  FullName 返回对象的名称（以字符串表示），包括其磁盘路径。String 型，只读。  Installed 如果已安装或将安装加载项，则该属性值为 True；如果已卸载或将卸载加载项，则该属性值为 False。可读写 Boolean 类型。  IsOpen 如果加载项当前打开，则返回 True。只读 Boolean 类型  Name 返回一个代表对象名称的 String 值。  Parent 返回指定对象的父对象。只读。  Path 返回一个 String 值，该值代表指向加载项的完整路径，不包括末尾的分隔符和加载项的名称。  progID 返回对象的程序标识符。String 型，只读。
学习和研究方法
office官网
搜索对象非常准确
先作为对象搜索，后面加上“对象”两字
再作为属性搜索，后面加上“属性”两字
网页结构
office VBA 参考
excel
对象
range
powerpoint
word
语言参考
概述
操作说明主题
参考
概述
字符集
常量
指令
活动
函数
转换函数
关键字
时间及日期
获取当前日期或时间
Date
今天日期
Now
现在时间
Time
现在日期和时间
转换
操作
日期转成序列号
DateSerial
指定年月日
DateValue
生成年月日序列
日期转成天、月、星期或年。
Year
Month
Day
Weekday
时间转成小时、分钟或秒。
Hour
Minute
Second
时间转成序列号。
TimeSerial
指定时分秒
TimeValue
生成时分秒序列
microsoft forms
对象
运算符
语句
visual basic 加载项模型
用户界面帮助
术语表
vba自带？
总是搜不到想要的
office编程手册
具有对象树形图
实验
用代码实验并写备注
录制宏
获取相关代码，然后百度或用上面方法查找并学习
应急性编程
流程
原文件备份
渐进式编程
步步测试代码是否成功
删除源文件备份
在编程成功之后
案例
新建题目课件并生成链接
背景
做题整理：按钮（新建题目课件），宏（模块1：新建题目课件并生成链接）
代码
Sub 新建题目课件并生成链接()
'创建文件系统对象
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
'设置文件路径
MainPath = ThisWorkbook.Path
文件路径 = MainPath & "\题库"
文件名 = "题目模板.pptx"
'创建文件对象
Set 文件对象 = 文件系统.getFile(文件路径 & "\" & 文件名)
'MsgBox 文件对象.Name '测试代码是否成功
'创建选中的单元格对象
Set 单元格 = Selection.Cells(1)
'MsgBox 单元格 '测试代码是否成功
文件后缀 = Right(文件名, Len(文件名) - InStrRev(文件名, "."))
'MsgBox 文件后缀 '测试代码是否成功
新文件名 = 单元格 & "." & 文件后缀
'复制文件并重命名
文件对象.Copy 文件路径 & "\" & 新文件名
'创建文件链接
ActiveSheet.Hyperlinks.Add 单元格, 文件路径 & "\" & 新文件名
End Sub
去标注后的代码
Sub 新建题目课件并生成链接()
Set 文件系统 = CreateObject("Scripting.FileSystemObject")
MainPath = ThisWorkbook.Path
文件路径 = MainPath & "\题库"
文件名 = "题目模板.pptx"
Set 文件对象 = 文件系统.getFile(文件路径 & "\" & 文件名)
Set 单元格 = Selection.Cells(1)
文件后缀 = Right(文件名, Len(文件名) - InStrRev(文件名, "."))
新文件名 = 单元格 & "." & 文件后缀
文件对象.Copy 文件路径 & "\" & 新文件名
ActiveSheet.Hyperlinks.Add 单元格, 文件路径 & "\" & 新文件名
End Sub
编程工具
可视化代码(用于检查代码对错)
'word对象.Range(头, 尾).Select
'查找范围.Select
'对象.select
'MsgBox 查找对象
'MsgBox 头 & Chr(13) & 尾
'MsgBox word对象.Range(头, 尾)
'报错记录(用于提高改错的效率)
溢出
根源为：数组的个数太少或太多
修改方法：选中多个单元格
参数不可选
根源是run调用宏和参数时没有加引号
修改方法：给宏名加引号，它是参数
类型不匹配
根源为：某个参数类型不匹配
修改方法：检查所有的（），括号里面很可能瞎填的没有修改，所以要养成习惯，不要瞎填，而是每一个代码都必须正确，报错就报错，快速直到错误就可以；
找不到某某文件
根源为：文件名或路径错或文件不存在
修改方法：检查文件名，往往少了后缀，建立标准的常用的文件夹信息代码
修改方法2：重新生成文件路径
缺少函数或变量
根源是没有function,但在调用返回值
修改方法：把相应sub改为function
缺少：语句结束
根源为：函数使用格式不对
修改方法：run的使用格式，调用宏和函数不一样，函数加括号，宏不加
'对象不支持此属性或方法;
根源为：Paragraph没有end属性，range有end属性； 或save少了一个e
修改方法：在paragraph后加.range 仔细检查方法或属性的单词是否自动变为大写
应用程序定义或对象定义错误
根源是没有把字符串数组改为整数
修改方法：把相应字符串用int或val改为数值
根源是调用宏时有重名的
修改方法：使得宏名唯一或加上模块名！
Microsoft Excel 正在等待其他某个应用程序以完成对象链接与嵌入操作
记录1：程序运行时蹦出此对话框，点击了确定37次，点击了关闭5次，运行10分钟，分解了32套试卷。
记录2：程序运行时蹦出此对话框，等待9分钟，点击关闭1次，分解了19个试卷
推测：可能弹窗和运行较慢有关，但是不马上点击弹窗不影响运行；所以，只要耐心等待运行完毕之后再点击关闭即可；需要通过运行少量文件预计时间，然后时间到了再关闭弹窗；
解决方案：1.只要不影响运行就可以容忍，解决方案就是等，等待运行时间足够长； 2.探索弹窗的报警取消方法；
400
根源是出现重复的宏
修改方法：删掉一个，或指定模块
函数输出结果与想的不一样
根源为：程序有漏洞
修改方法：不要在判断和循环外面决定参数结果
redim 列表（n）n不是个数而是上界
excel
cells慎用，应该用active.cells
二义性
函数或宏重名
窗口是否可见
Application
Visible = False '窗口不可见
Visible = True '窗口可见
统计运行时间
time_start = Timer '统计时间
MsgBox "ok,用时" & Round(Timer - time_start, 2) & "秒!" '统计时间
编程逻辑总结
查找
Sub
Sub 查找()
选中全文区域
Selection.Start = 0 Selection.End = ActiveDocument.Content.End Selection.find.ClearFormatting
选中内容.起始位置=开头 选中内容.结尾位置=文本.内容.结尾 选中内容.查找.清楚格式
查找“发”
With Selection.Find .Text = "发" .Font.Bold = True .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = True .Execute End With
with 相当于省重复的部分，后面都有选中内容.查找 选中内容.查找.内容=发 选中内容.查找.格式.加粗=是 选中内容.查找.内容=空 选中内容.查找.替换.内容=空 选中内容.查找.向下否=是 选中内容.查找.到达尾时=停止查找 选中内容.查找.格式否=是 在选中内容中比对查找内容一致的位置作为选中内容
选中“发”后面到结尾的区域
Selection.Start = Selection.Start + Len("发") Selection.End = ActiveDocument.Content.End End Sub
选中内容.起始位置=现在起始位置越过查找内容的长度 选中内容.结尾位置=文本.内容.结尾
function
Function find(find_start, find_end, message)
查找并返回位置（开头，结尾，信息）
选中查找区域
Selection.Start = find_start Selection.End = find_end
选中文本.起始位置=开头 选中文本.结尾位置=结尾
查找信息
Selection.find.ClearFormatting Selection.find.Text = message Selection.find.Execute
选中文本.查找.清楚格式 选中文本.查找.内容=信息 在选中文本中比对查找文本一致的位置并作为新选中区域
是否找到
是
If Selection.find.Found Then find = Selection.Start
如果找到了 返回找到的位置（即现在选中的开头）
否
Else find = find_end End If
如果没有 返回原来的查找结尾 结束如果
选中结尾处
Selection.Start = find_end Selection.End = find_end End Function
选中文本.起始位置=结尾 选中文本.结尾位置=结尾 结束函数
改进“是否找到”， 最终选中位置有变换
是否找到
是
If Selection.find.Found Then find = Selection.Start Selection.Start = find + Len(message) Selection.End = find + Len(message)
如果找到了 返回找到的位置（即现在选中的开头） 选中文本.起始位置=信息后面 选中文本.结尾位置=信息后面
否
Else find = find_end Selection.Start = find_end Selection.End = find_end End If
如果没有 返回原来的查找结尾 选中文本.起始位置=结尾 选中文本.结尾位置=结尾 结束如果
结束
End Function
结束函数
改进“信息查找” 查找的是粗体格式
信息查找
Selection.find.ClearFormatting Selection.find.Text = message Selection.find.Font.Bold = True Selection.find.Execute
选中文本.查找.清楚格式 选中文本.查找.内容=信息 选中文本.查找.格式.加粗=是 在选中文本中比对查找文本一致的位置并作为新选中区域
单元格
单元格获取内容 并内容非空
如果重名修改名 直到不重名
复制模板表单 并重命名
单元格创建链接
选择区域内的单元格生成对应表单并链接
区域
遍历每个单元格
执行单元格程序
激活区域所在表单
单元格
单元格获取内容 并内容非空
单元格内容 作为表单名 是否有重名
否
复制模板表单 并重命名
单元格创建链接
是
主函数任务
初始化界面
开始
结束
程序流程图
方法
是否xx
运行1
运行2
是否xx
返回
结束