请高手帮忙修改一段运行不起来的自动加目录的代码

cofe2000

mBEF1LyS.rar (34.96 KB, 下载次数: 59)

2004-7-15 08:49 上传

点击文件名下载附件
请高手帮忙修改一段运行不起来的自动加目录的代码

cofe2000

以下是引用winak在2004-7-15 9:19:00的发言： 进入死循环了

你好，自从你大喜之后好久没有见到你了，怪想你的：）

能给我说说怎么解决吗？谢谢

守柔

TO COFO兄：

你仔细看一下，所谓的目录如运用**对象，与文档中的目录一样吗？中间有空格，怎么可能相同，而设置呢？

最简单的方法，你用查找，看一下，所谓的从2到13的区域，在文档中有几个？

另外，我觉得上半过程可以调整一下：(减少长文档循环)

Sub hh() Dim i As Integer, r As Long For r = 14 To 100'(我的测试) For i = 2 To 13 If ActiveDocument.Paragraphs(r).Range = ActiveDocument.Paragraphs(i).Range Then ActiveDocument.Paragraphs(r).Range.Style = ActiveDocument.Styles("标题1") End If Next Next End Sub

cofe2000

谢谢，的确有空格，是不一样的

但如果上半过程可以调整一下：(减少长文档循环)的话，就不能遍历整个文件了啊？

守柔

以下是引用cofe2000在2004-7-15 10:19:00的发言：

谢谢，的确有空格，是不一样的

但如果上半过程可以调整一下：(减少长文档循环)的话，就不能遍历整个文件了啊？

为什么不能呢？

你是从2 开始到13，其中嵌套一个整个文档的循环，以判断从第14段落开始与其中是否相同；

而我的意思是从14开始到段落最后，其中嵌套一个从2开始到13的小代码，以判断是否相同，应该一样的。

等会儿我可能再传一个更简单一点的，运行速度也快的代码。

守柔

Sub hh() Dim i As Paragraph, n As Byte, a As Byte, b As Byte, x As Long a = 2 b = 13 x = 0 For Each i In ActiveDocument.Paragraphs x = x + 1 For n = a To b If x > b Then If i.Range = ActiveDocument.Paragraphs(n).Range Then i.Range.Style = ActiveDocument.Styles("标题1") 'MsgBox "ÕÒµ½Ïàͬ´¦" a = a + 1 End If End If Next Next End Sub 注意:你可人为将2到13行的文本粘贴到后面的文档中(本文仅讨论如何在段落中循环),使其相同,再运行此宏,你看一下速度!(a=a+1是建立在你的目录的惟一性上)

cofe2000

pHc0edXa.rar (37.6 KB, 下载次数: 20)

2004-7-15 13:10 上传

点击文件名下载附件
请高手帮忙修改一段运行不起来的自动加目录的代码

守柔

怪，明明早上通过的呀！录制宏也是“标题1”，可现在不行了，改为以下代码即可：

我已将其中的“标题”与前十二段相同。

Sub Contents() Dim i As Paragraph, n As Byte, a As Byte, b As Byte, x As Long, DelRange As Range Application.ScreenUpdating = False a = 2 b = 13 x = 0 For Each i In ActiveDocument.Paragraphs x = x + 1 For n = a To b If x > b Then If i.Range = ActiveDocument.Paragraphs(n).Range Then i.Range.Select Selection.Style = ActiveDocument.Styles(wdStyleHeading1) a = a + 1 End If End If Next Next Set DelRange = Range(ActiveDocument.Paragraphs(2).Range.Start, ActiveDocument.Paragraphs(13).Range.End) DelRange.Delete ActiveDocument.Paragraphs(2).Range.Select With ActiveDocument .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _ True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _ LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _ UseHyperlinks:=True, HidePageNumbersInWeb:=True .TablesOfContents(1).TabLeader = wdTabLeaderDots .TablesOfContents.Format = wdIndexIndent End With Application.ScreenUpdating = True End Sub

aCVis3gK.zip (48.4 KB, 下载次数: 93)

2004-7-15 14:13 上传

点击文件名下载附件
请高手帮忙修改一段运行不起来的自动加目录的代码

cofe2000

太感谢你啦！向你学习

winak

进入死循环了