oracle vba 数组_vba：使用array中的文本从selection.find返回页码

(注意：请参阅下面的解决方案.)

我一直在尝试使用VBA从word文档中的各种标题页面中检索页码.我当前的代码返回2或3,而不是正确关联的页码,具体取决于我在主Sub中使用它的位置和方式.

astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)

For Each hds In astrHeadings

docSource.Activate

With Selection.Find

.Text = Trim$(hds)

.Forward = True

MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly

End With

Selection.Find.Execute

docSource是我设置的测试文档,有3个页面的10个标题.我有从后来在我的代码中使用的getCrossReferenceItems方法检索的标题.

我正在尝试循环getCrossReferenceItems方法的结果,并在docSource上的Find对象中使用它们,并从中确定结果在哪个页面上.然后,我的代码中的页码将在稍后的字符串中使用.这个字符串加上页码将被添加到另一个在我的主子开头创建的文档中,其他所有文件都可以处理,但这个代码段.

理想情况下,我需要这个段做的是用每个Find结果中的相关页码填充第二个数组.

解决问题

谢谢凯文,你在这里得到了很大的帮助,我现在从这个Sub的输出中得到了我所需要的.

docSource是我设置的测试文档,有3个页面的10个标题.

docOutline是一个新文档,它将作为目录文档.

我不得不使用这个Sub over Word的内置TOC功能,因为：

>我有多个文件要包含,我可以使用RD字段来包含这些文件

>我有另一个Sub,它在每个文件0.0.0(chapter.section.page代表)中生成自定义小数页编号,对于整个文档包来说有意义,需要作为页码包含在TOC中.可能有另一种方法可以做到这一点,但我发现了Word的内置功能.

这将成为我的页码编号Sub中包含的函数.我现在是完成这个小项目的3/4,最后一个季度应该是直截了当的.

修改并清理了最终代码

Public Sub CreateOutline()

' from https://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document

Dim docOutline As Word.Document

Dim docSource As Word.Document

Dim rng As Word.Range

Dim strFootNum() As Integer

Dim astrHeadings As Variant

Dim strText As String

Dim intLevel As Integer

Dim intItem As Integer

Dim minLevel As Integer

Dim tabStops As Variant

Set docSource = ActiveDocument

Set docOutline = Documents.Add

minLevel = 5 'levels above this value won't be copied.

' Content returns only the

' main body of the document, not

' the headers and footer.

Set rng = docOutline.Content

astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)

docSource.Select

ReDim strFootNum(0 To UBound(astrHeadings))

For i = 1 To UBound(astrHeadings)

With Selection.Find

.Text = Trim(astrHeadings(i))

.Wrap = wdFindContinue

End With

If Selection.Find.Execute = True Then

strFootNum(i) = Selection.Information(wdActiveEndPageNumber)

Else

MsgBox "No selection found", vbOKOnly

End If

Selection.Move

docOutline.Select

With Selection.Paragraphs.tabStops

'.Add Position:=InchesToPoints(2), Alignment:=wdAlignTabLeft

.Add Position:=InchesToPoints(6), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots

End With

For intItem = LBound(astrHeadings) To UBound(astrHeadings)

' Get the text and the level.

' strText = Trim$(astrHeadings(intItem))

intLevel = GetLevel(CStr(astrHeadings(intItem)))

' Test which heading is selected and indent accordingly

If intLevel <= minLevel Then

If intLevel = "1" Then