Hello Everyone,
Greetings to All.
I have some Issues in the below Macro.
My intention is to Copy/Insert the multiple Images in a folder that I select to the multiple sheets of a excel workbook.
The Macro should only have to insert the select images to the sheets.
The sheets are named as "Sheet1, Sheet2, Sheet3... etc..."
And Suppose if there are 20 Sheets in the workbook and I have 10 Images to insert it in Sheet1, Sheet2..........Sheet10, then I want to delete the remaining sheets(that is Sheet11, Sheet12.....Sheet20).
Currently I'm using the below Macro, But it is not working.
Could anyone write/modify the macro to above said conditions.
Thanks in Advance.
Sub Insert_Picture()
Dim myPicture As Variant
Dim myCell As Range
Dim lLoop As Long
Dim Sht As Worksheet
On Error Resume Next
myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif; *.png),*.gif; *.jpg; *.bmp; *.tif *.png", , "SELECT FILE(S) TO IMPORT", MultiSelect:=True)
If VarType(myPicture) = vbBoolean Then
MsgBox "NO FILES SELECTED"
Else
For lLoop = LBound(myPicture) To UBound(myPicture)
For Each Sht In ActiveWorkbook.Worksheets
Sht.Select
With ActiveSheet
Set myCell = .Range("I4:S26")
.Pictures.Insert(myPicture).Select
With myCell
Selection.Top = .Top
Selection.Left = .Left
Selection.Width = .Width
Selection.Height = .Height
Selection.Placement = xlMoveAndSize ' move and size with cells
End With
End With
Next Sht
Application.ScreenUpdating = True
Next lLoop
End If
End Sub
Bookmarks