|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 weiyingde 于 2017-4-24 12:12 编辑
一、鸣谢:
在本坛duquancai、jiminyanya、dafanshu1、loquat等多位大侠、朋友的启蒙、指教和帮助下,完成了本程序,没有他们的帮助,就没有这些代码。所以,本程序可以说是他们的原创,我只不过是,把他们的智慧综合一下。对他们帮助和指教表示衷心的感谢!!
二、申明:
(1)、由于初学word,基础不牢(可以说还未启蒙),代码免不了冗余啰嗦、不够条理,所以运行缓慢,不流畅等等毛病,希望这些朋友,继续援手,共同完善。
(2)、特别是结尾部分添加或修改整理日期,更是毛病百出。
(3)、特别希望大侠增加它更多的功能,优化提速代码,使之更有效率。
(4)、说是万能那是出发点和最终的目标,而并非眼前的实际功能。
三、本程序功能作用:
1、可做试卷的母版,隐藏或显示答案。
2、整理网上下载的带乱码的文档,删去多余的空格;
3、格式化文档:改变字体、颜色、并且做到加粗标题等。
更多的功能,期待你的加入和添加。
Public 次数 As Integer
Sub 一键万能格式整理()
Dim pars As Paragraphs
次数 = 次数 + 1
k = 次数 Mod 2 + 1
Dim bl As Boolean
mStr = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Randomize
z1 = Int(Rnd * 3 + 1)
z2 = Int(Rnd * 4 + 1)
'On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕刷新
Dim par As Paragraph
Set rg = ActiveDocument.Paragraphs(1).Range
sr = rg.Text
If Left(Right(sr, 2), 1) <> "。" Then
rg.MoveEnd , -1
rg.InsertAfter vbCr
bl = False
Else
bl = True
End If
If bl = False Then rg.Text = Left(sr, rg.Characters.Count - 1) & "。"
With ActiveDocument.Content '以下处理空格(包括全角、半角)、断行、空行等
.Font.ColorIndex = wdBlack
With .Find
.Execute "^l", , , 1, , , , , , "^p", 2
.Execute "^13^32{1,}", , , 1, , , , , , "^p", 2
.Execute "^t", , , 1, , , , , , "", 2
.Execute "([一-隝]@)([ ]{1,})([一-隝]@)", , , 1, , , , , , "\1\3", 2
.Execute "([一-隝]@)(^32{1,})([一-隝]@)", , , 1, , , , , , "\1\3", 2
.Execute "([!。:……?!)])^13{1,}", , , 1, , , , , , "\1", 2
.Execute "^s", , , , , , , , , "", 2
End With
End With
With ActiveDocument.Content '以下处理各种特殊格式
With .Find '处理中文字体
.Replacement.Font.NameFarEast = Choose(z2, "楷体", "华文楷体", "方正启体简体", "黑体")
.Execute "([一-隝]@)", , , 1, , , , , , "^&", 2
End With
With .Find '处理西文字体
.Replacement.Font.NameAscii = Choose(z2, "方正姚体", "Arial Black", "Arial Narrow", "Impact", "Franklin Gothic Medium Cond")
.Execute "([A-Za-z]@)", , , 1, , , , , , "^&", 2
End With
With .Find '处理“一、二……十"这样的项目
With .Replacement.Font
.NameFarEast = "华文新魏"
.ColorIndex = wdDarkBlue
.Size = 18
End With
.Execute "([一二三四五六七八九十]@[、,]*^13)", , , 1, , , , , , "^&", 2
End With
With .Find '处理“(一)、(二)……(十)"这样的项目
.Replacement.Font.NameFarEast = "方正康体简体"
.Replacement.Font.ColorIndex = wdDarkBlue
.Replacement.Font.Size = 15
.Execute "([\((\[【][一二三四五六七八九十甲乙丙丁]@[\))\]】][、,]*^13)", , , 1, , , , , , "^&", 2
End With
With .Find '处理答案,包括(ABCD)形式的答案,再就是答:这种形式的答案。
Do While .Execute("[\((\[【][A-D]@[\))\]】]", , , 1) '1, , , , , , "^&", 2
With .Parent
.Start = .Start + 1: .End = .End - 1
.Font.Name = "Arial Black"
.Font.ColorIndex = Choose(k, 8, 2)
.Font.Size = 18
.Collapse 0
End With
Loop
End With
With ActiveDocument.Content.Find
.Replacement.Font.ColorIndex = Choose(k, 8, 2)
.Replacement.Font.Underline = wdUnderlineWavy
.Replacement.Font.UnderlineColor = wdColorDarkBlue
.Execute "(^13答:*^13)", , , 1, , , , , , "\1", 2 '隐藏答案
End With
With ActiveDocument.Content.Find
.Replacement.Font.ColorIndex = 1
.Execute "答:", , , 1, , , , , , , 2, 2 '显示"答案"二字。
End With
End With
With ActiveDocument.Paragraphs(1) '处理第一段格式
.Format.Alignment = wdAlignParagraphCenter
With .Range.Font
.Bold = True
.ColorIndex = Choose(z1, wdDarkBlue, wdBlack, wdBlue, wdViolet)
.NameFarEast = Choose(z1, "腾祥范笑歌楷书简", "华文隶书", "华文新魏")
End With
End With
For i = 2 To ActiveDocument.Paragraphs.Count ' 处理其他各段行距,体体大小
With ActiveDocument.Paragraphs(i)
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 14
.Format.CharacterUnitFirstLineIndent = 2
.Range.Font.Size = 10.5
End With
Next
Set rg = ActiveDocument.Paragraphs(1).Range '删除第一段(文章标题)的句号,恢复其本来内容
sr = ActiveDocument.Paragraphs(1).Range.Text
If Left(Right(sr, 2), 1) = "。" Then rg.MoveEnd , -1: rg.InsertAfter vbCr
With ActiveDocument.Paragraphs(1)
If Left(Right(sr, 2), 1) = "。" Then .Range = Left(sr, Len(sr) - 2)
.Range.Font.Size = 22
End With
With ActiveDocument '在最后一段修改或添加整理日期。
With .Content.Find
If .Found = True Then
.Execute "([0-9]{4}年[0-9]月{2}[0-9]{2}日)", , , 1, , , , , , "^&", 1
.Replacement.Text = Format(Date, "yyyy年mm月dd日")
Else
With ActiveDocument.Paragraphs
Set rng = ActiveDocument.Paragraphs(.Count).Range
rng.MoveEnd , -1: rng.InsertAfter vbCr
ActiveDocument.Paragraphs(.Count).Range = Format(Date, "yyyy年mm月dd日整理")
ActiveDocument.Paragraphs(.Count).Format.Alignment = wdAlignParagraphRight
End With
End If
End With
End With
ActiveDocument.Content.ParagraphFormat.DisableLineHeightGrid = -1
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
|
评分
-
1
查看全部评分
-
|