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

kerry786032

琢磨几天，终于想到这个代码可以在遍历文章段落的时候跳过表格，要不然有些大的表格在里面，遍历的时候会非常慢。希望大家提点意见，水平不咋地，见笑。




Sub skip_table()
Dim i As Integer
    Dim p As paragraph
    Dim Select_count As Integer
    Dim myrange As Range
    Dim table_count As Integer
    selection.HomeKey wdStory
On Error Resume Next
    selection.EndKey unit:=wdStory
    selection.Find.ClearFormatting

    With selection.Find
        .Text = "1. Introduction"
        .MatchWildcards = False
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    selection.Find.Execute

    selection.collapse wdCollapseEnd
Set myrange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(1).Range.Start, End:=selection.Range.End)
    table_count = myrange.Paragraphs.count
    For i = table_count To ActiveDocument.Paragraphs.count

    If ActiveDocument.Paragraphs(i).Range.Information(wdWithInTable) Then
    ActiveDocument.Paragraphs(i).Range.Select

        selection.MoveDown unit:=wdParagraph, count:=1
        selection.Tables(1).Range.Select
        Select_count = selection.Range.Paragraphs.count

        i = i + Select_count - 3
        ActiveDocument.Paragraphs(i).Range.Characters(1).Select
        selection.HomeKey unit:=wdLine

        Else
        ActiveDocument.Paragraphs(i).Range.Style = ActiveDocument.Styles("_4_text")


    End If
    Next i
End Sub

wdpfox

多谢老师慷慨分享好资料！我水平低，要学习才能懂的。
　　　　　　Oooo
　　　　　　(___)
　　oooO  　 )_/
　　(___) 　 (_/
　　 \_(
　　　\_)

413191246se

楼主，你的问题我喜欢，也想寻找更好的跳过表格只处理文本的方法！——但是，我实践以后，怀疑楼主是否清醒，是否认真测试了文本。

413191246se

另外，楼主，我的《Word2003通用模板宏（2018元旦版）》代码，只须一键 F8 即可自动处理公文排版，你是否研究过？

kerry786032

413191246se 发表于 2018-3-16 14:46
楼主，你的问题我喜欢，也想寻找更好的跳过表格只处理文本的方法！——但是，我实践以后，怀疑楼主是否清醒 ...

经过这段时间测试，已更改 i = i + Select_count - 1为 i = i + Select_count - 3，有哪些问题，还请指出？

kerry786032

413191246se 发表于 2018-3-16 14:47
另外，楼主，我的《Word2003通用模板宏（2018元旦版）》代码，只须一键 F8 即可自动处理公文排版，你是否研 ...

暂时没有，是否可以麻烦给个链接？一定拜读！！！

duquancai

kerry786032 发表于 2018-3-16 15:55
经过这段时间测试，已更改 i = i + Select_count - 1为 i = i + Select_count - 3，有哪些问题，还请指出 ...

既然是“分享贴”，谢谢分享，那就没什么好说的了！

413191246se

楼主，请参见我的代码：http://club.excelhome.net/thread-1389169-1-1.html

413191246se

* 楼主，你的态度很好，钻研精神可嘉！谢谢！
* 但是，楼主你的代码，我测试以后，发现文档没有任何变化，我仍然怀疑楼主头脑是否清醒？
* 或许，是我水平太低，不能理解？

413191246se

* 楼主，我昨天下午重新写了 3 种跳过表格只处理文字的代码，请参考：

1. Sub a计算宏运行所用时间()
   
2.     Dim t As Single
   
3.     t = Timer
   
4.     test1 '宏名-------test1=.101'---->第一种方法最快！
   
5.     MsgBox "OK！用时 " & Timer - t & " 秒！", vbOKOnly + vbExclamation, "计算宏运行所用时间"
   
6. End Sub
   
7. Sub test1()
   
8. '目标：设置表格外文字为红色！
   
9.     Dim d As Document
   
10.     Set d = ActiveDocument
    
11. 
    
12. '方法1：Do...Loop逐段循环------用时 .109/.101/.104秒
    
13. '    On Error Resume Next
    
14.     d.Content.InsertAfter Text:="`"
    
15.     d.Paragraphs(1).Range.Select
    
16.     With Selection
    
17.         Do
    
18.             If Selection Like "*`*" Then Exit Do
    
19.             If .Information(wdWithInTable) = False Then
    
20.                 .Font.Color = wdColorRed
    
21.                 .Next(unit:=wdParagraph, Count:=1).Select
    
22.             Else
    
23.                 .Tables(1).Range.Next(unit:=wdParagraph, Count:=1).Select
    
24.             End If
    
25.         Loop
    
26.     End With
    
27. End Sub
    
28. Sub test2()
    
29. '方法2：独创/原创-----------用时：.519/.531/.539秒
    
30.     On Error Resume Next
    
31.     Dim doc As Document, t As Table, i As Paragraph, j&, k&, r As Range, v&
    
32.     Set doc = ActiveDocument
    
33. 
    
34.     If doc.Paragraphs(1).Range.Information(wdWithInTable) = False Then
    
35.         Selection.HomeKey unit:=wdStory
    
36.         doc.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=1
    
37.         v = 1
    
38.     End If
    
39. 
    
40.     For Each t In doc.Tables
    
41.         With t.Range
    
42.             .Rows.WrapAroundText = False
    
43.             .Rows.Alignment = wdAlignRowCenter
    
44.             .Previous(unit:=wdParagraph, Count:=1).Characters.Last.InsertBefore Text:="`"
    
45.         End With
    
46.     Next
    
47.     doc.Content.InsertAfter Text:="`"
    
48. 
    
49.     k = doc.Tables.Count
    
50.     Do
    
51.         j = j + 1
    
52.         doc.Tables(j).Range.Next(unit:=wdParagraph, Count:=1).Characters(1).Select
    
53.         Selection.MoveEndUntil cset:="`", Count:=wdForward
    
54.         Selection.MoveEnd unit:=wdCharacter, Count:=2
    
55. 
    
56.         Selection.Font.Color = wdColorRed
    
57. 
    
58.         Selection.Characters.Last.Previous.Delete
    
59.     Loop Until j = k
    
60.     If v = 1 Then doc.Tables(1).Delete
    
61. End Sub
    
62. Sub test3()
    
63. '方法3：循环遍历段落法------用时：.941/.906/.910秒
    
64.     Dim i As Paragraph
    
65.     For Each i In ActiveDocument.Paragraphs
    
66.         If i.Range.Information(wdWithInTable) = False Then i.Range.Font.Color = wdColorRed
    
67.     Next
    
68. End Sub

复制代码