Vba 将映像复制到目录中的所有工作簿

我知道如何打开目录中的所有工作簿，我需要打开源工作簿，从wbPicture.xlsx复制图像

Picture 100

，并为每个打开的wbdestination删除wbdestination中每个工作表第84行下方的任何形状

我在谷歌上搜索发现，您可以使用此功能将图像从一个工作簿复制到另一个工作簿，但如何说明每个工作表，以及如何删除现有图像（如果它们已经是一个）？

Sub CopyImage()
Dim imagewb As String
Dim openedwb As Workbook
Dim workbook As Workbook
Dim destbook As String
Dim totalbooks As Int
Dim bookname As String
Dim fulllist() As String

imagewb = "C:\Image.xlsx"
Set openedwb = Workbooks.Open(imagewb)

'Selecting image from template workbook
For Each shape in ActiveSheet.Shapes
  If shape.Name = "Picture 100" Then
    shape.Select
    shape.Copy
  End If
Next shape

Set WB = ActiveWorkbook

'Setting location of destination workbooks
destbook = "\\Hiya\ExcelFiles\"

totalbooks = 0
'Getting name of all .xlsx workbooks
bookname = Dir(destbook & "*.xlsx")

'Creating array
totalbooks = totalbooks + 1
ReDim Preserve fullList(1 To totalbooks)
fullList(totalbooks) = bookname
bookname = Dir()
Wend

For int totalbooks = 1 To UBound(fullList)
Set openedwb = Workbooks.Open(destbook & fullList(totalbooks))
'Selecting 1st sheet
Sheets(1).Select
'Pasting image from clipboard to workbook
With Sheets(1)
  .Paste(.Range("A81"))
End With

'Saving workbook & opening next
openedwb.Save
openedwb.Close False

End Sub

---

这将删除任何图像，无论引用范围中包含的名称等，在我的示例中，引用范围是“A81:Z250”

引用工作簿中包含的每张工作表，直接从

---

感谢您的语法，但是当我尝试迭代所有工作表时，语法不会出现错误，但实际上不会更新所有工作表。

For Each shape In ActiveSheet.Shapes
  If Not Application.Intersect(shape.TopLeftCell, .Range("A81:Z250")) Is Nothing Then
      If shape.Type = msoPicture Then
        shape.Delete
    End If
  End If
Next shape

      Sub WorksheetLoop()

     Dim WS_Count As Integer
     Dim I As Integer

     ' Set WS_Count equal to the number of worksheets in the active
     ' workbook.
     WS_Count = ActiveWorkbook.Worksheets.Count

     ' Begin the loop.
     For I = 1 To WS_Count

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ActiveWorkbook.Worksheets(I).Name

     Next I

  End Sub