Ошибка автоматизации MS Word при попытке заменить закладку на содержимое ячейки Excel - PullRequest
Новая
       16

Ошибка автоматизации MS Word при попытке заменить закладку на содержимое ячейки Excel

0 голосов
/ 29 июня 2019

Цель моего кода - найти закладки в текстовом документе и заменить информацию именем клиента, адресом или оценочной суммой.Мой код ищет закладку, содержащую определенную информацию (например, закладки выглядят как [имя], [адрес], [оценка]), а затем заменяет ее информацией в определенной ячейке на листе Excel.Я хочу, чтобы код просматривал все закладки по всему документу, заменял их соответствующей информацией и сохранял закладки.Есть две проблемы с кодом.Во-первых, это говорит о неправильном использовании «Я» (имеется в виду часть кода Me.Repaint).и если я пытаюсь запустить код без Me.Repaint, я получаю ошибку во время выполнения VBA'-2146959355 (80080005) ': ошибка автоматизации.У кого-нибудь есть предложения по поводу того, что я мог бы сделать по-другому?спасибо

Я попытался удалить меня. Перекрасить, и я попытался перезапустить слово.У меня также есть объекты Excel, включенные в разделе ссылок VBA. 

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

есть ошибка автоматизации.

Ответы [ 2 ]

0 голосов
/ 02 июля 2019

Я не вижу Me.Repaint в коде вопроса, который предположительно вызывает ошибку ...? Это запускается из пользовательской формы? Насколько я знаю, это не часть Word или Excel ...

В любом случае в коде в этих строках три раза присутствует синтаксическая ошибка: 

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
0 голосов
/ 29 июня 2019

Настройка 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
...