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

我知道如何打开目录中的所有工作簿，我需要打开我的源工作簿，并从wbPicture.xlsx中复制Picture 100 ，并为每个打开的wbdestination删除任何形状，在每个工作表上的第84行wbdestination。

我GOOGLE了，发现你可以使用这个从一个工作簿复制图像到另一个，但如何解释每个工作表，以及如何删除现有的图像（如果他们已经是一个）？

 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 

Answer 1

这将删除任何图像，无论名称等被包含在引用的范围内，在我的例子中引用的范围是“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 

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

  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