遍历文章段落的时候跳过表格

duquancai · 发表于 2018-3-17 13:24

413191246se 发表于 2018-3-17 13:14
* 楼主，你的态度很好，钻研精神可嘉！谢谢！
* 但是，楼主你的代码，我测试以后，发现文档没有任何变化， ...

他这跳过表格的代码，基本属于初级阶段。呵呵！最佳的算法是：定义一个指针，首先指针指向文档首，遍历指针直到文档尾部（反过来也可以定义文档尾指针，然后向上遍历）如果指针指向了表格那么立即跳过整个表格而指向非表格段落。

duquancai · 发表于 2018-3-17 14:02

413191246se 发表于 2018-3-17 13:06
楼主，请参见我的代码：http://club.excelhome.net/thread-1389169-1-1.html

几天周末，分享一下我的代码，并做了详细注释！

Sub Skip_Table()
' 本代码是由文档的首部向下遍历非表格段落直到文档尾部,如果需要从文档尾部向上遍历到文档首部，代码完全类似！
Dim d As Document
Set d = ActiveDocument
With d.Range(0, 0) '用With结构定义了一个指针变量并初始化指向文档首，也可以定义一个指针变量Dim p as Range
Do While .End < d.Content.End - 1 '如果指针指向的地址不是文档尾部的地址,那么进入循环
If .Information(12) Then '如果指针指向的地址为表格的首地址，那么：
.Expand 15: .Move '指针跳过整个表格而指向该表格之后的段落首地址
Else
' 根据具体需求，对该段落进行操控!
With .Paragraphs(1).Range '定义另外一个指针而指向整个段落
.Font.Name = "黑体"
.Bold = -1
.Font.Size = 20
End With
.Move 4 '指针指向下一个段落首地址
End If
Loop '循环到Do开始
End With
End Sub

复制代码

13907933959 · 发表于 2018-3-17 16:26

duquancai 发表于 2018-3-17 14:02
几天周末，分享一下我的代码，并做了详细注释！

杜前辈好！
第一次见您带注释的代码！虽然不懂，还是惊喜！

13907933959 · 发表于 2018-3-18 06:19

413191246se 发表于 2018-3-17 13:17
* 楼主，我昨天下午重新写了 3 种跳过表格只处理文字的代码，请参考：

师傅好！
3个一起收藏了！谢谢！

413191246se · 发表于 2018-3-18 10:20

* 谢谢杜先生！辛苦了！
* 去年，就得到杜先生不厌其烦的帮助，写了不少关于设置标题2345的代码，内心十分感激。
* 杜先生去年写了两段《正则表达式》代码，一个是修改格式，一个是查找替换，最近我认真对比后，觉得喜欢第一段代码（修改格式）；但也不大会用，感觉是正则表达式比WORD查找替换还是会快上许多；
* 周五下午，我重新写了 3 段《处理表格外段落》的代码，对比了一下运行时间，选了最快的，也是最简单的方法：首先选中第1段，然后，用 Do...Loop 循环，一旦光标落到表格中，就选择表格下面一段文字，但循环到最后一段，停不下来，只好先在文尾插入一个字符`来，再删除，速度还是比较快的；但与昨晚杜先生代码一比较，还是败下阵来，决定采用杜先生的这段《指针》代码；杜先生做了详细的注释，但我还是不大理解，因为本人太愚钝了！
* 下面是我周五最快的一种跳过表格的代码，让杜先生见笑了！——并请杜先生注意休息，适当给我们指导帮助：

Sub test()
'目标：设置表格外段落！
Dim d As Document
Set d = ActiveDocument
d.Content.InsertAfter Text:="`"
d.Paragraphs(1).Range.Select
With Selection
Do
If .Information(wdWithInTable) = False Then
With .Font
.Name = "黑体"
.Bold = -1
.Size = 20
End With
If Selection Like "*`*" Then Exit Do
.Next(unit:=wdParagraph, Count:=1).Select
Else
.Tables(1).Range.Next(unit:=wdParagraph, Count:=1).Select
End If
Loop
End With
d.Characters.Last.Previous.Delete
End Sub
Sub a计算宏运行所用时间()
Dim t As Single
t = Timer
test '宏名------杜先生 .5'/.29/.437 我的代码 .468/.437/.390
MsgBox "OK！用时 " & Timer - t & " 秒！", vbOKOnly + vbExclamation, "计算宏运行所用时间"
End Sub

复制代码

duquancai · 发表于 2018-3-18 11:59

413191246se 发表于 2018-3-18 10:20
* 谢谢杜先生！辛苦了！
* 去年，就得到杜先生不厌其烦的帮助，写了不少关于设置标题2345的代码，内心 ...

只是针对你说的：“进入死循环”，我在你的代码基础上修改如下

Sub test()
' 目标：设置表格外段落！
Dim d As Document
Set d = ActiveDocument
d.Paragraphs(1).Range.Select
With Selection
Do While .End < d.Content.End - 1
If .Information(wdWithInTable) = False Then
With .Font
.Name = "黑体"
.Bold = -1
.Size = 20
End With
.Next(unit:=wdParagraph, Count:=1).Select
Else
.Tables(1).Range.Next(unit:=wdParagraph, Count:=1).Select
End If
Loop
End With
End Sub

复制代码

：

413191246se · 发表于 2018-3-18 13:54

* 呵呵！不好意思！杜先生——你的代码败北了！
* 我决定还是采用我原来的原创《跳过表格只处理文本》代码。
* 杜先生也不妨测试一下，全部代码如下：（请注意看宏运行时间比较，在处理有表格文档时）

Sub a计算宏运行所用时间()
Dim t As Single
t = Timer
test '宏名------杜先生 6.39/6.21/6.31 我的代码----1.76/1.76/1.42
MsgBox "OK！用时 " & Timer - t & " 秒！", vbOKOnly + vbExclamation, "计算宏运行所用时间"
End Sub
Sub test_du()
Dim d As Document, t As Table
Set d = ActiveDocument
With d
For Each t In .Tables
With t.Range
.Rows.WrapAroundText = False '取消表格环绕
.Rows.Alignment = wdAlignRowCenter
.Font.Name = "仿宋_GB2312"
.Font.Name = "Times New Roman"
End With
Next
With .Range(0, 0)
Do While .End < d.Content.End - 1
If .Information(12) Then
.Expand 15: .Move
Else
With .Paragraphs(1).Range
.Select
正文样式
If Len(Selection) = 1 And Asc(Selection) = 13 Then .Delete: GoTo skip '分页符后面的回车符删不掉！
End With
.Move 4
End If
skip:
Loop
End With
End With
End Sub
Sub test()
On Error Resume Next
Dim doc As Document, t As Table, i As Paragraph, j&, k&, r As Range, v&
Set doc = ActiveDocument
If doc.Paragraphs(1).Range.Information(wdWithInTable) = False Then
Selection.HomeKey unit:=wdStory
doc.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=1
v = 1
End If
For Each t In doc.Tables
With t.Range
.Rows.WrapAroundText = False
.Rows.Alignment = wdAlignRowCenter
.Font.Name = "仿宋"
.Font.Name = "Times New Roman"
.Previous(unit:=wdParagraph, Count:=1).Characters.Last.InsertBefore Text:="`"
End With
Next
doc.Content.InsertAfter Text:="`"
k = doc.Tables.Count
Do
j = j + 1
doc.Tables(j).Range.Next(unit:=wdParagraph, Count:=1).Characters(1).Select
Selection.MoveEndUntil cset:="`", Count:=wdForward
Selection.MoveEnd unit:=wdCharacter, Count:=2
正文样式
Selection.Characters.Last.Previous.Delete
Set r = Selection.Range
For Each i In r.Paragraphs
If Len(i.Range) = 1 And Asc(i.Range) = 13 Then i.Range.Delete
Next
r.Select
Loop Until j = k
If v = 1 Then doc.Tables(1).Delete
End Sub
Sub 正文样式()
'更新
With Selection
.ClearFormatting
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
With .Font
.Name = "仿宋_GB2312"
.Name = "Times New Roman"
.Size = 16
.Color = wdColorBlue
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.LineSpacing = LinesToPoints(1.25)
.CharacterUnitFirstLineIndent = 2
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
End With
End With
End Sub

复制代码

413191246se · 发表于 2018-3-18 14:31

* 杜先生，请有空指导一下，假设现在要设置所有表格外段落：
* 有两种方式：
* 第一种：表1/文1/表2/文2/表3/文3
* 第二种：文1/表1/文2/表2/文3/表3
* 如何选定文1、文2、文3设置蓝色，要选定文字区域，不逐段设置
*** 最终幻想：既然不连续的表格能一次全部选定，为何文字不能一次选定而一次设置格式呢？
* 请杜先生指教（我试了，一次选定所有文字区域，当然按住CTRL键，能一次设置为正文样式）。
* 附《全选表格》代码：

Sub 表格全选()
Dim doc As Document, t As Table
Set doc = ActiveDocument
With doc
.DeleteAllEditableRanges wdEditorEveryone
For Each t In .Tables
t.Range.Editors.Add wdEditorEveryone
Next
.SelectAllEditableRanges wdEditorEveryone
.DeleteAllEditableRanges wdEditorEveryone
End With
End Sub

复制代码

413191246se · 发表于 2018-3-18 14:33

本帖最后由 413191246se 于 2018-3-18 18:13 编辑

（略）。。。。。。

413191246se · 发表于 2018-3-18 14:36

谢谢杜先生 16楼指针指导，还是懵懵懂懂……

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

[分享] 遍历文章段落的时候跳过表格

评分