在特定段落的段首添加字符

yym_0114

我需要达到的效果是：在没有※标记的段落前加上※。举例：

※《齐齐哈尔市志稿·交通志》，内部发行，1988年，第6页。

※徐世昌等编纂：《东三省政略》，长春：吉林文史出版社，1989年。

※《齐齐哈尔市第二商业局志》，内部发行，1992年，第17-21页。

齐齐哈尔档案馆藏：《齐齐哈尔经济概况》。

齐齐哈尔档案馆藏：《黑龙江省城办理市政报告书》。

《齐齐哈尔市志·文化卷》，合肥：黄山书社, 1999年，第125-129页。

※齐齐哈尔市档案馆藏档案51-34-51。

※魏声和：《鸡林旧闻录》，长春：吉林文史出版社，1986年，第47页。

※丁世良、赵放编：《中国地方志民俗资料汇编》东北卷，北京：北京图书馆出版社，1989年。

[美]Walter Young：《美报之华人满洲移民运动观》，《东方杂志》1928年第25卷第24号。[美]Walter Young：《美报之华人满洲移民运动观》，《东方杂志》1928年第25卷第24号。

※丁世良、赵放编：《中国地方志民俗资料汇编》东北卷，北京：北京图书馆出版社，1989年。

我的思路是：先查找段前不带※的段落；然后判断该段落有几行，如果有一行，就用现在的代码，如果是一行以上，就增加一个把光标调整到段首的代码；最后用替换的方法加上※。

现在遇到的问题是这样的：上面三个一行的段落都没问题，但是最下面那个两行的段落，不管我怎么调整代码，※的位置总是在第二行之前，而不能到段首的位置。关键问题是，我不知道这个判断段落行数的代码该怎么写；或者能不能换一个思路来达到目的。这就要请教word VBA方面的高手了。多谢！

我现在的代码是这样的：

1. Sub 宏6()
   
2. Selection.Find.ClearFormatting
   
3. Selection.Find.Replacement.ClearFormatting
   
4.     With Selection.Find
   
5.         .Text = "^13[!※]*^13"
   
6.         .Replacement.Text = "^&"
   
7.         .Forward = True
   
8.         .Wrap = wdFindContinue
   
9.         .MatchWildcards = True
   
10.     End With
    
11.     Selection.Find.Execute
    
12.     Selection.MoveUp Unit:=wdParagraph, Count:=-1
    
13.     Selection.MoveUp Unit:=wdLine, Count:=1
    
14. 
    
15. With Selection.Find
    
16.         .Text = "*^13"
    
17.         .Replacement.Text = "※^&"
    
18.         .Forward = True
    
19.         .Wrap = wdFindStop
    
20.         .MatchWildcards = True
    
21.     End With
    
22.     Selection.Find.Execute Replace:=wdReplaceOne
    
23. End Sub

复制代码

补充内容 (2022-9-19 15:34):
已解决

13907933959

网友好！
如果是每个没有的段落都加上※，你可试一下这个。

Sub 宏6()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^13"
        .Replacement.Text = "^&※"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "※※"
        .Replacement.Text = "※"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "※^13"
        .Replacement.Text = "^13"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

hhjjpp

1. Sub 宏6()
   
2. With Selection.Find
   
3.     .ClearFormatting
   
4.     .Text = "^13[!※]"
   
5.     .Replacement.Text = ""
   
6.     .Forward = True
   
7.     .Wrap = wdFindContinue
   
8.     .MatchWildcards = True
   
9.     .Execute
   
10.     Selection.MoveRight Unit:=wdCharacter, Count:=1
    
11.     Selection.HomeKey Unit:=wdLine
    
12.     Selection.InsertBefore "※"
    
13. End With
    
14. End Sub

复制代码

hhjjpp

1. Sub 宏6()
   
2. Dim dline%, search As Boolean
   
3. dline = ActiveDocument.Range.ComputeStatistics(wdStatisticLines)         '文档总行数
   
4. With Selection.Find
   
5.     .ClearFormatting
   
6.     .Text = "^13[!※]"
   
7.     .Replacement.Text = ""
   
8.     .Forward = True
   
9.     .Wrap = wdFindContinue
   
10.     .MatchWildcards = True
    
11.     Do
    
12.          .Execute
    
13.          search = Right(Selection.Text, 1) <> Chr(13)
    
14.          Selection.MoveRight Unit:=wdCharacter, Count:=1
    
15.          If search Then
    
16.             Selection.HomeKey Unit:=wdLine
    
17.             Selection.InsertBefore "※"
    
18.          End If
    
19.     Loop Until dline = Selection.Information(wdFirstCharacterLineNumber) '当前光标所在行数
    
20. End With
    
21. End Sub
    

复制代码

duquancai

请你测试：
Sub shishi()
    With CreateObject("VBscript.regexp")
        .Global = True: .IgnoreCase = False: .MultiLine = True
        .Pattern = "^(?!※|$)"
        ActiveDocument.Content.Text = .Replace(ActiveDocument.Content.Text, "※")
    End With
End Sub

yym_0114

13907933959 发表于 2016-7-17 08:54
网友好！
如果是每个没有的段落都加上※，你可试一下这个。

非常感谢您的回复！实际测试之后没问题。虽然是分三步达到目的，但以我粗浅的VBA知识，可以很快理解代码的意思和思路。非常好！已经采纳您的回复了！

yym_0114

hhjjpp 发表于 2016-7-17 09:08

感谢您的回复！您的代码每次只能对一行进行修改。

yym_0114

hhjjpp 发表于 2016-7-17 10:36

感谢您的回复！我把您的代码复制到我的word VBA里面，运行之后※标记在一个段落中无限复制，直到word崩溃。

yym_0114

duquancai 发表于 2016-7-17 19:12
请你测试：
Sub shishi()
    With CreateObject("VBscript.regexp")

感谢您的回复！实际测试之后，您的代码可以达到我要的效果。但请恕我VBA知识有限，您的代码我没有看懂是什么原理。而且不知为什么，运行您的代码之后，我的段前空两格、红色字体的格式全都没了，都变成了左对齐的黑色字体。

duquancai

yym_0114 发表于 2016-7-17 23:40
感谢您的回复！实际测试之后，您的代码可以达到我要的效果。但请恕我VBA知识有限，您的代码我没有看懂是 ...

段落缩进及字体格式等自己重新排版！！！