Question

我正在使用VBA宏来呈现所有＆＃34;标题1＆＃34;从word文档的样式文本。它工作正常但是花费大量时间取决于word doc的内容。

我正在循环每个段落以检查＆＃34;标题1＆＃34;样式并将文本渲染为数组。

我想知道是否有另一种方法可以简单地找到＆＃34;标题1＆＃34;样式并将文本存储在数组中，这将大大减少执行时间。

在我的宏程序下面，我将非常感谢有关上述内容的专家意见。

Sub ImportWordHeadings()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim sHeader(50) As String
Dim Head1counter As Integer
Dim arrcount As Long
Dim mHeading As String

On Error Resume Next
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file


 p = 1
  RetCount = 0
  parg = wdDoc.Paragraphs.Count

For Head1counter = 1 To parg

   If wdDoc.Paragraphs(Head1counter).Range.Style = "Heading 1" Then

        sHeader(p) = wdDoc.Paragraphs(Head1counter).Range.Text
        p = p + 1
        Else
        p = p
   End If
Next Head1counter

For arrcount = RetCount + 1 To UBound(sHeader)

  If sHeader(arrcount) <> "" Then
        Debug.Print sHeader(arrcount)
        RetCount = arrcount
Exit For
  Else
        RetCount = RetCount
  End If
Next arrcount

Set wdDoc = Nothing

End Sub

Answer 1

您可以使用Find method搜索所有标题，与我所做的over here on Code Review非常相似。

Set doc = ActiveDocument
Set currentRange = doc.Range 'start with the whole doc as the current range

With currentRange.Find
    .Forward = True             'move forward only
    .Style = wdStyleHeading1    'the type of style to find
    .Execute                    'update currentRange to the first found instance

    dim p as long 
    p = 0
    Do While .Found

        sHeader(p) = currentRange.Text

        ' update currentRange to next found instance
        .Execute
        p = p + 1
    Loop
End With

找到所有标题1文本并将其放入数组

1 个答案: