时间戳

首页 > 解决方案 > Excel VBA - 带有 462 错误的 Word.Selection 问题

vba - Excel VBA - 带有 462 错误的 Word.Selection 问题

问题描述

我正在创建一个 Excel vba 来搜索 word 文档中的关键字，然后返回它上面的行。这是代码：

Sub TEST()

Dim s As Word.Selection
fileaddress = "C:\XXXXXX"

Set appWrd = New Word.Application
Set docWrd = appWrd.Documents.Open(fileaddress)
Set aRange = docWrd.Range

Do
    aRange.Find.Text = "keyword"
    aRange.Find.Execute Forward:=True
    If aRange.Find.Found Then
        aRange.Select
        Set s = Word.Selection
        s.MoveUp Unit:=wdLine, COUNT:=1
        MsgBox s.Paragraphs(1).Range.ListFormat.ListString
        Set s = Nothing
    End If
Loop While aRange.Find.Found

docWrd.Close
appWrd.Quit

End Sub

该代码第一次运行良好，然后在第二次出现 462 错误。我想问题可能出在这个 Word.Selection 上。有什么想法吗？

PS：word文件是这样的：

  1. 标题样式 1

关键词

1.1 标题样式 2

关键词

因此代码搜索关键字，然后将光标从关键字位置向上移动一行，然后 msgbox 将返回“1”和“1.1”。但是，正如我所说，代码第一次运行良好。我认为这与上次运行 excel 后任务管理器中没有杀死某些进程有关。

解决了

新代码：

Sub TEST()

Dim s As Word.Selection
fileaddress = "C:\XXXXXX"

Set appWrd = New Word.Application
Set docWrd = appWrd.Documents.Open(fileaddress)
Set aRange = docWrd.Range

Do
    aRange.Find.Text = "keyword"
    aRange.Find.Execute Forward:=True
    If aRange.Find.Found Then
        aRange.Select
        Set s = appWrd.Selection   '<------- This is the only change!
        s.MoveUp Unit:=wdLine, COUNT:=1
        MsgBox s.Paragraphs(1).Range.ListFormat.ListString
        Set s = Nothing
    End If
Loop While aRange.Find.Found

docWrd.Close
appWrd.Quit

End Sub

标签： vbams-word

解决方案

当您提到“上面的线”时，我尝试检查该单词是否在表格中或句子中。所以我将文档中的单词与关键字进行比较，然后读取表格中的上一行或它所属的句子，然后倒数直到找到上一个句子。

Sub TEST_Line(fileaddress As String, Keyword As String)
   Set appWrd = CreateObject("Word.Application")
   Set docWrd = appWrd.Documents.Open(fileaddress)
   Set DWords = docWrd.Words
   For Counter = 1 To DWords.Count
      If UCase(Keyword) Like UCase(DWords.Item(Counter)) Then
         If DWords.Item(Counter).Tables.Count > 0 Then
            Row_Ref = DWords.Item(Counter).Rows(1).Index - 1
            Col_Ref = DWords.Item(Counter).Columns(1).Index
            If Row_Ref > 0 Then
               MsgBox DWords.Item(Counter).Tables(1).Columns(Col_Ref).Cells(Row_Ref).Range.Text
            End If
         Else
            aRange = DWords.Item(Counter).Sentences(1)
            Reverse_Counter = Counter - 1
            If Reverse_Counter < 1 Then
               'MsgBox "First Sentence"
            Else
               Do While DWords.Item(Reverse_Counter).Sentences(1) = DWords.Item(Counter).Sentences(1)
               Reverse_Counter = Reverse_Counter - 1
               Loop
               MsgBox DWords.Item(Reverse_Counter).Sentences(1)
            End If
         End If
      End If
   Next Counter
   docWrd.Close
   appWrd.Quit
End Sub

推荐阅读