Question

我的代码的目标是在整个Word文档中查找书签，并将信息替换为客户的姓名，地址或评估金额。我的代码搜索包含某些信息的书签（例如，书签看起来像[名称]，[地址]，[评估]），然后将其替换为excel工作表中特定单元格中的信息。我希望代码查看整个文档中的所有书签，并用适当的信息替换它并保留书签。代码有两个问题。第一，它说“ Me”的使用不当（指代码的Me.Repaint部分）。如果我尝试在没有Me.Repaint的情况下运行代码，则会收到VBA运行时错误“ -2146959355（80080005）”：自动化错误。有人对我可以做些什么有任何建议吗？谢谢

我尝试删除me.repaint，并尝试重新启动word。我还在VBA参考部分中打开了excel对象。

Function Read_Excel_Cell(cellRin As Long) As String
Dim oExcel As Excel.Application
Dim myWB As Excel.Workbook
Set oExcel = New Excel.Application
Set myWB = oExcel.Workbooks.Open("excel file")
Read_Excel_Cell = myWB.Sheets(1).Cells(cellRin, 1)
Set myWB = Nothing
Set oExcel = Nothing
End Function

Sub clientinfoexcel()
Dim bmk As Bookmark
For Each bmk In ActiveDocument.Range.Bookmarks
cltext = bmk.Name
Dim clinfo1 As Range
Set clinfo1 = ActiveDocument.Bookmarks(cltext).Range
If clinfo1.Text Like "*name*" Then
    clinfo1.Text = Text: Read_Excel_Cell (1)
    ActiveDocument.Bookmarks.Add cltext, clinfo1
ElseIf clinfo1.Text Like "*address*" Then
    clinfo1.Text = Text: Read_Excel_Cell (2)
    ActiveDocument.Bookmarks.Add cltext, clinfo1
ElseIf clinfo1.Text Like "*appraisal*" Then
    clinfo1.Text = Text: Read_Excel_Cell (3)
    ActiveDocument.Bookmarks.Add cltext, clinfo1
End If
Next bmk
End Sub

存在自动化错误。

Answer 1

设置myWB和oExcel =什么都不会关闭工作簿或退出excel，因此您可能打开了一堆隐藏的excel实例-在任务管理器中签入。

仅需一次打开/关闭即可获取所需的数据。

例如（未经测试）：

Sub clientinfoexcel()
    Dim bmk As bookmark, arrData
    Dim clinfo1 As Range

    arrData = ReadExcelData()

    For Each bmk In ActiveDocument.Range.bookmarks
        txt = bmk.Range.Text

        If txt Like "*name*" Then
            SetBookMarkText bmk, arrData(1, 1)
        ElseIf txt Like "*address*" Then
            SetBookMarkText bmk, arrData(1, 1)
        ElseIf txt Like "*appraisal*" Then
            SetBookMarkText bmk, arrData(1, 1)
        End If
    Next bmk
End Sub

'Set the text in a bookmark without destroying it
Sub SetBookMarkText(bmk As bookmark, txt As String)
    Dim nm, rng
    nm = bmk.Name
    Set rng = bmk.Range
    rng.Text = txt
    rng.Parent.bookmarks.Add nm, rng
End Sub

'return Excel data as a 2-d array
Function ReadExcelData()
    Dim oExcel As Excel.Application
    Dim myWB As Excel.Workbook
    Set oExcel = New Excel.Application
    Set myWB = oExcel.Workbooks.Open("excel file")
    ReadExcelData = myWB.Sheets(1).Range("A1:A10").Value 'for example
    myWB.Close False 'don't save
    oExcel.Quit
End Function

Answer 2

我在问题代码中看不到Me.Repaint，这可能导致错误...？这是从UserForm运行吗？据我所知，这不是Word或Excel的一部分...

无论如何，这些行的代码中有3次语法错误：

clinfo1.Text = Text: Read_Excel_Cell (1)

这是不正确的：Text:

我相信您想要拥有的是：

clinfo1.Text = Text:= Read_Excel_Cell(1)

要指定参数:=，而不是:。

除此之外，代码可能会更有效率。如果ActiveDocument.Bookmarks[index]循环已经为书签提供了For对象，则无需重复bmk。而且我认为，Select Case比许多ElseIf语句更易于阅读和编写维护。

我还更改了Excel的代码，以便它只能启动一次新的Excel实例-如果找不到运行的Excel。有多种方法可以处理您要使用Excel应用程序执行的操作-这只是一种可能性。如果您想进一步探索，我建议您进行更多的研究（这里和其他地方有很多问题和代码示例），以及针对该主题的另一个针对性更窄的问题。

Function Read_Excel_Cell(cellRin As Long) As String
  Dim oExcel As Excel.Application
  Dim myWB As Excel.Workbook

  On Error Resume Next
  Set oExcel = GetObject(, "Excel.Appplication")
  If Err.Number = 429 Then
    Set oExcel = New Excel.Application
  End If
  On Error GoTo 0

  oExcel.Visible = True
  For Each myWb in oExcel.Workbooks
    If myWb.Name = "excel file" Then
      Exit For
    End If
  Next

  If myWb Is Nothing Then
    Set myWB = oExcel.Workbooks.Open("excel file")
  End If

  Read_Excel_Cell = myWB.Sheets(1).Cells(cellRin, 1)
  Set myWB = Nothing
  Set oExcel = Nothing
End Function

Sub clientinfoexcel()
  Dim bmk As Bookmark
  For Each bmk In ActiveDocument.Range.Bookmarks
    cltext = bmk.Name
    Dim clinfo1 As Range
    Set clinfo1 = bmk.Range
    Select Case cltext
       Case Like "*name*"
            clinfo1.Text = Read_Excel_Cell(1)
            ActiveDocument.Bookmarks.Add cltext, clinfo1
       Case Like "*address*" 
            clinfo1.Text = Read_Excel_Cell(2)
            ActiveDocument.Bookmarks.Add cltext, clinfo1
       Case Like "*appraisal*" Then
           clinfo1.Text = Read_Excel_Cell(3)
           ActiveDocument.Bookmarks.Add cltext, clinfo1
    End Select
  Next bmk
End Sub

尝试用Excel单元格内容替换书签时出现MS Word自动化错误

2 个答案: