Ошибка времени выполнения 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