word宏将以数字开头的段落最后增加*号

shao84314 · 发表于 2016-6-20 15:33

word宏将以数字开头的段落最后增加*号如何做？
我搜索了全论坛找到更改以数字开头段落样式的例子，但没有增加的，我尝试增加不成功请高手帮指点下。
现有代码：

Sub 测试11()
'
' 测试11 宏
'
'
Dim KeyWord As String '声明变量
Dim i As String '声明变量
KeyWord = "1" '输入框选择值赋值给变量
If KeyWord = "" Then Exit Sub '如果输入框为空,则退出过程(过程叫 Sub)
i = vbYes
Selection.HomeKey wdStory '光标移到文档首
Do 'DO...LOOP 循环
With Selection.Find 'WITH 语句(查找)
.Text = KeyWord '查找某词，平时是 .Text="要点"
.Wrap = wdFindStop '找到后停止
.Forward = True '向前查找
End With 'WITH 语句结束
If Selection.Find.Execute = False Then Exit Do 'IF条件语句(如果找不到则退出 DO 循环)
If i = vbYes Then '消息框 MsgBox 提问：如果“是”则（关键词在段首则设置为黑体、红色）
Selection.Paragraphs(1).Range.Select '选择光标所在段落
If (Left(Selection.Text, Len(KeyWord))) = KeyWord Then '如果查找到的关键词所在段落左取 N 个字符正好等于关键词的话，则
Selection.Paragraphs(1).Range.Select '选择光标所在段落
With Selection.Font 'WITH 语句(字体格式)
.Bold = True '加粗(是)
.name = "仿宋_GB2312" '中文字体名字(黑体)
.Size = 14 '字号12磅(四号)
End With '结束 WITH 语句
Selection.EndKey Unit:=wdLine '光标移到行尾
Else '否则
Selection.MoveDown Unit:=wdParagraph '向下移动一段
End If '结束 IF 语句
Else '消息框 MsgBox 提问：如果“否”则（关键词在段中则设置为楷体、绿色）
Selection.Paragraphs(1).Range.Select '选择光标所在段落
With Selection.Font 'WITH 语句(字体格式)
.Color = wdColorGreen '颜色(绿色)
.Bold = True '加粗(是)
.name = "仿宋_GB2312" '中文字体名字(楷体)
.name = "Times New Roman" '英文字体名字(Times New Roman 音译：泰姆斯·妞·罗曼,这个英文字体比较通用\美观\正规)
.Size = 12 '字号12磅(四号)
End With '结束 WITH 语句
Selection.EndKey Unit:=wdLine '光标移到行尾
End If '结束 IF 语句
Loop 'DO...LOOP 循环结束
Selection.HomeKey Unit:=wdStory '光标移到文档首
End Sub

复制代码

duquancai · 发表于 2016-6-20 16:24

请测试：
Sub test()
Dim S As Range, reg As Object
Set reg = CreateObject("VBscript.regexp")
Set S = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
With reg
      .Global = True: .IgnoreCase = False: .MultiLine = True
      .Pattern = "^(\d+[^\r]*)(\r)"
      S = .Replace(S, "$1" & "*" & "$2")
End With
Set S = Nothing: Set reg = Nothing
End Sub

shao84314 · 发表于 2016-6-20 16:54

duquancai 发表于 2016-6-20 16:24
请测试：
Sub test()
Dim S As Range, reg As Object

多谢大神解决问题，先解燃眉之急完了找书系统学习

菜菜行者 · 发表于 2016-6-20 21:23

duquancai 发表于 2016-6-20 16:24
请测试：
Sub test()
Dim S As Range, reg As Object

这个$1，$2，是什么意思

13907933959 · 发表于 2016-6-21 06:58

duquancai 发表于 2016-6-20 16:24
请测试：
Sub test()
Dim S As Range, reg As Object

前辈好！
这个代码需可以完美的将以数字开头的段落末尾加上*号，但也会改变原文档的所有格式，如不改变原文档的所有格式能否办到。恳请前辈赐教！谢谢！

duquancai · 发表于 2016-6-21 12:38

本帖最后由 duquancai 于 2016-6-21 14:53 编辑

13907933959 发表于 2016-6-21 06:58
前辈好！
这个代码需可以完美的将以数字开头的段落末尾加上*号，但也会改变原文档的所有格式，如不改变 ...

上面代码也不是你说的那样：“改变了所有”格式，只是部分格式。请你测试下面代码
Sub test2()
Dim reg As Object, i As Paragraph
Dim mt, mts As Object, oRang As Range, n%, m%
Set reg = CreateObject("vbscript.regexp")
On Error Resume Next
For Each i In ActiveDocument.Paragraphs
      With reg
         .Pattern = "^\d+[^\r]*"
         .Global = True: .IgnoreCase = False
         Set mts = .Execute(i.Range.Text)
         For Each mt In mts
            m = mt.firstindex
            n = mt.Length
            Set oRang = ActiveDocument.Range _
            (i.Range.Start + m, i.Range.Start + m + n)
               oRang.InsertAfter "*"
         Next
      End With
Next
End Sub

13907933959 · 发表于 2016-6-21 14:26

duquancai 发表于 2016-6-21 12:38
上面代码也不是你说的那样：“改变了所有”格式，只是部分格式。请你测试下面代码
Sub test2()
Dim ...

前辈好！
罪过、用词不准，还请你原谅！
不知什么原因，代码运行后提示：编译错误，子过程或函数未定义，代码中Range被选中，还请前辈再看看。

duquancai · 发表于 2016-6-21 14:40

13907933959 发表于 2016-6-21 14:26
前辈好！
罪过、用词不准，还请你原谅！
不知什么原因，代码运行后提示：编译错误，子过程或函数未定义 ...

我的office2010能用。
你可你把  ： “Set oRang = Range _
            (i.Range.Start + m, i.Range.Start + m + n)”
改为：“Set oRang = ActiveDocument.Range _
            (i.Range.Start + m, i.Range.Start + m + n)”

13907933959 · 发表于 2016-6-21 16:15

本帖最后由 13907933959 于 2016-6-22 09:01 编辑

duquancai 发表于 2016-6-21 14:40
我的office2010能用。
你可你把： “Set oRang = Range _
(i.Range.Start + m, i.Ra ...

前辈好！
谢谢您的再次的回复！这次OK了，佩服前辈的实力！
前辈、如要在数字开头的段落末尾加一个任意字符（包括任意中文字符），要怎样修改，求再赐教！谢谢！

duquancai · 发表于 2016-6-21 17:35

13907933959 发表于 2016-6-21 16:15
前辈好！
谢谢您的再次的回复！这次OK了，佩服前辈的实力！
前辈、如要在数字开头的段落末尾加一个任意 ...

'在数字开头的段落末尾加一个或者多个任意字符：
Sub 数字开头段尾加字符()
Dim reg As Object, i As Paragraph, oStr$
Dim mt, mts As Object, oRang As Range, n%, m%
Set reg = CreateObject("vbscript.regexp")
oStr = InputBox("请输入任意字符：", "数字开头段尾加字符...")
If oStr = "" Then Exit Sub
For Each i In ActiveDocument.Paragraphs
      With reg
         .Pattern = "^\d+[^\r]*"
         .Global = True: .IgnoreCase = False
         Set mts = .Execute(i.Range.Text)
         For Each mt In mts
            m = mt.firstindex
            n = mt.Length
            Set oRang = ActiveDocument.Range _
            (i.Range.Start + m, i.Range.Start + m + n)
            oRang.InsertAfter oStr
         Next
      End With
Next
End Sub

		自动登录	找回密码
密码			免费注册

[求助] word宏 将以数字开头的段落最后增加*号

[求助] word宏将以数字开头的段落最后增加*号