Метод 'Вставить' объекта'_Worksheet 'Не удалось - как решить? - PullRequest
0 голосов
/ 17 марта 2020

Ошибка времени выполнения 1004 Метод Вставить объектную таблицу не удалось, выбрасывая в строке ниже. Как исправить?

Размещение полного кода ниже для дополнительного контекста. Я могу получить одно изображение для перемещения в выбранную пользователем ячейку, но после первой итерации For l oop @ bottom появляется ошибка.

Sub unload_word()
Dim wdApp As Object
Dim wdSH As InlineShape
Dim sCell As Range

On Error Resume Next
Set wdApp = GetObject(, "Word.Application") 'get open word doc
On Error GoTo 0
If wdApp Is Nothing Then
    MsgBox "Word is not open."
    Exit Sub
End If

If wdApp.Documents(1).InlineShapes.count = 0 Then 'find images in word doc
    MsgBox "There are no images in this Word Doc."
    Exit Sub
End If

Dim shapecount As Integer 'counts # of images in the doc
shapecount = wdApp.Documents(1).InlineShapes.count
MsgBox "There are " & shapecount & " items in the selected document."

Dim wbOtherWB As Workbook
'checks to see if there's another excel book open, besides the one running the macro. other workbook will be the place where images are pasted
For Each wbOtherWB In Application.Workbooks
    If Not wbOtherWB Is ThisWorkbook Then
        Exit For
    End If
Next wbOtherWB
If wbOtherWB Is Nothing Then
    MsgBox "No other workbooks are open.", vbExclamation 'if theres not another workbook open then cancel the macro
    Exit Sub
End If
Dim usersheet As Worksheet
Set sCell = Application.InputBox("Select one cell", Type:=8) 'prompt user to choose a cell location
Set usersheet = ActiveSheet 'make user selected sheet a reference point for later
If sCell Is Nothing Then Exit Sub
If sCell.Cells.count > 1 Then MsgBox "Pick one cell only"

For Each wdSH In wdApp.Documents(1).InlineShapes 
    wdApp.Documents(1).Activate 'activate word doc
    wdSH.Range.Copy 'copy image
    usersheet.Activate 'activate sheet where user chose cell
    usersheet.Paste Destination:=sCell 'paste in user cell. throws 1004 error
    Application.CutCopyMode = False 'clear clipboard
Next
End Sub

1 Ответ

0 голосов
/ 17 марта 2020

Это прекрасно работает для меня:

Dim usersheet As Worksheet
Set sCell = Application.InputBox("Select one cell", Type:=8) 'prompt user to choose a cell location
Set usersheet = ActiveSheet
If sCell Is Nothing Then Exit Sub
If sCell.Cells.Count > 1 Then
  MsgBox "Pick one cell only"
  GoTo ErrExit
End If
For Each wdSH In wdApp.Documents(1).InlineShapes
    wdSH.Range.Copy
    usersheet.Paste Destination:=sCell
Next
Application.CutCopyMode = False
ErrExit:
wdApp.Quit

Без большего количества вашего кода для контекста, хотя (особенно в отношении создания экземпляра wdApp, ссылочного документа и wd SH), невозможно знать что может происходить в другом месте.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...