没有合适的资源?快使用搜索试试~ 我知道了~
Sub F2无格式粘贴到新word并保存关闭() Sub F3无格式粘贴程序() Sub F4带图表粘贴到新word并保存关闭() Sub F5格式调整程序() Sub F6编号() Sub F7加答案() Sub F8批处理() Sub F8批处理_AllDir() Sub F8批处理_AllFile() Sub F8批处理_文档解密() Sub F8批处理_重命名() Sub F8批处理_word导出图片()
资源推荐
资源详情
资源评论
Public excelRows As Integer '锁 F8
Public myDoc As Object '锁 F8
Public wordApp As Object '锁 F8
Public excelApp As Object '锁 F8
Public mySheet As Object '锁 F8
Public xlBook As Object '锁 F8
Public defaultPath As String '锁 F8
Public isAsk As Boolean '锁 F8
Public myCurCommand As String '锁 F8 F8 批处理类型
Public myCommand As String '锁 F0 F8 考试科目
Public myReCommand As String '锁 F8 F8 最下级命令
Public myConst As String '锁 F8 F8 常数命令集
Public isClose As Boolean '锁 F5/保存
Public myNewName As String 'F8 文字/保存
Public isReName As Boolean '保存/F8 移动图表
Public isKillFile As Boolean 'F8 文字
Public myClass As String 'F8 资料分类
Public extensionMsg As String 'F8 扩展名信息
Public extensionName As String 'F8 扩展名
Public extensionNames As String 'F8 所有扩展名(动)
Public extensionAllName As String 'F8 所有扩展名(静)
Public myAllName() As String 'F8 图片名称
Public keyWord As String 'F8 关键字
Public myCount As Integer 'F6/F7/F9/F8 图片
Public isReColor As Boolean 'F6
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 '公共
Sub F2 无格式粘贴到新 word 并保存关闭() '
' 用法(不选择→F2):(没有窗口打开,新建文档) + 无格式粘贴 + 清除考试大等相关
信息 + 格式/字体/段落调整 + 保存 + 关闭
' 用法( 全选 →F2):区别在于,有窗口打开也新建
Dim isUnSave As Boolean
myCommand = "F2"
If Application.Documents.Count > 0 Then
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End Then
Documents.Add DocumentType:=wdNewBlankDocument '如果全选,新建文档
End If
If ActiveDocument.Paragraphs.Count > 2 Then
' Documents.Add DocumentType:=wdNewBlankDocument ' 新建文档 网速过的去,
就不新建
End If
Else
Documents.Add DocumentType:=wdNewBlankDocument '新建文档
End If
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine,
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 '新建文档
' oWordApplic.Documents.Add(strName,
System.Reflection.Missing.Value,System.Reflection.Missing.Value, Boolean isVisible) ' 用模
板新建文档
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 Link:=False, DataType:=wdPasteText, Placement:=wdInLine,
DisplayAsIcon:=False '无格式粘贴
' 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
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End Then
Documents.Add DocumentType:=wdNewBlankDocument '如果全选,新建文档
End If
If ActiveDocument.Paragraphs.Count > 2 Then
' Documents.Add DocumentType:=wdNewBlankDocument '新建文档
End If
Else
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 Then
If InStr(ActiveDocument.Range.Text, "</") > 0 Then F7 加答案 '去格式标记
F7 加答案 '如果全选,保存下划线、加粗等格式
issaveformat = True
End If
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 '设置初始值 firstValue(第一题编号),默认为 1
myCount = 0 '设置初始值 mycount(每套试题数量),默认为 0(不作限制)
isReColor = False: myBool = True
If Selection.Range.Start = 0 And Selection.Range.End = ActiveDocument.Range.End Then '如
果全选
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) + ";每套试题数量=" +
CStr(myCount))
If myStr = "" Then Exit Sub
firstValue = Mid(myStr, InStr(myStr, "初始值=") + 4, InStr(myStr, "每套试题数量=") -
InStr(myStr, "初始值=") - 5)
myCount = Mid(myStr, InStr(myStr, "每套试题数量=") + 7)
myInt = firstValue
End If
If Selection.Range.Start = Selection.Range.End Then
Selection.WholeStory
End If
'##############################################################################
###########
If myBool Then
Do
With Selection.Find
.Text = " ([0-9]{1,})."
.Replacement.Text = " " + CStr(myInt) + "."
.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
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.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
.Text = "( [0-9]{1,})."
剩余36页未读,继续阅读
资源评论
xj06541
- 粉丝: 2
- 资源: 25
上传资源 快速赚钱
- 我的内容管理 展开
- 我的资源 快来上传第一个资源
- 我的收益 登录查看自己的收益
- 我的积分 登录查看自己的积分
- 我的C币 登录后查看C币余额
- 我的收藏
- 我的下载
- 下载帮助
最新资源
- 论文(最终)_20240430235101.pdf
- 基于python编写的Keras深度学习框架开发,利用卷积神经网络CNN,快速识别图片并进行分类
- 最全空间计量实证方法(空间杜宾模型和检验以及结果解释文档).txt
- 5uonly.apk
- 蓝桥杯Python组的历年真题
- 2023-04-06-项目笔记 - 第一百十九阶段 - 4.4.2.117全局变量的作用域-117 -2024.04.30
- 2023-04-06-项目笔记 - 第一百十九阶段 - 4.4.2.117全局变量的作用域-117 -2024.04.30
- 前端开发技术实验报告:内含4四实验&实验报告
- Highlight Plus v20.0.1
- 林周瑜-论文.docx
资源上传下载、课程学习等过程中有任何疑问或建议,欢迎提出宝贵意见哦~我们会及时处理!
点击此处反馈
安全验证
文档复制为VIP权益,开通VIP直接复制
信息提交成功