Insert Different Picture into Multiple Sheets

[muhammad susanto]

hi all...


how to inserting different 3 pictures in different cell and different sheets ( i have over 50 sheets in 1 file)

Sub InsertPic() Dim I As Long
    Dim xPath As String
    Dim xShape As Shape
    Dim xRg As Range
    xPath = "G:\foto_test\1.jpg,2.jpg,3.jpg"
    If Dir(xPath) = "" Then
        MsgBox "Picture file was not found in path!", vbInformation, "test"
        Exit Sub
    End If
    For I = 1 To ActiveWorkbook.Sheets.Count
        Set xRg = Sheets(I).Range("B10:C10") ("D10:E10") ("f10:g10")
        Set xShape = Sheets(I).Shapes.AddPicture(xPath, True, True, xRg.Left, xRg.Top, xRg.Width, xRg.Height)
    Next End Sub

file name of picture are e.g. 1.jpg, 2.jpg,3.jpg


my target is how to insert picture in cell with criteria :
1.jpg----inserted into cell B10:C10 for each sheet
2.jpg----inserted into cell D10:E10 for each sheet
3.jpg----inserted into cell F10:G10 for each sheet


anybody would help me and greatly appreciated


susanto

[Admin]

Hi

try this

Sub InsertPic()
    
    Dim I As Long
    Dim xPath As String
    Dim xShape As Shape
    Dim xRg As Range
    
    Dim xFiles
    Dim j   As Long
    Dim a   As Range
    
    xPath = "L:\test\"
    xFiles = Array("1.jpg", "2.jpg", "3.jpg")
    
    If Dir(xPath & "*.jpg") = "" Then
        MsgBox "Picture file was not found in path!", vbInformation, "test"
        Exit Sub
    End If
    
    For I = 1 To ActiveWorkbook.Sheets.Count
        Set xRg = Sheets(I).Range("B10:C10,D10:E10,f10:g10")
        For j = 1 To xRg.Areas.Count
            Set a = xRg.Areas(j)
            Set xShape = Sheets(I).Shapes.AddPicture(xPath & xFiles(j - 1), True, True, a.Left, a.Top, a.Width, a.Height)
        Next
    Next

End Sub

[muhammad susanto]

thank you Admin, that's i want it..
[SOLVED]

[muhammad susanto]

hello man...

i have new problem..how to insert 40 pictures e.g. 1jpg, 2.jpg, etc...INTO ONLY in cell H10 for each sheet
i try modify code Set xRg = Sheets(I).Range("h10") but not working..

would you help me? please..

[Admin]

try

    For i = 1 To ActiveWorkbook.Sheets.Count
        Set xRg = Sheets(i).Range("H10")
        Set xShape = Sheets(i).Shapes.AddPicture(xPath & xFiles(i - 1), True, True, xRg.Left, xRg.Top, xRg.Width, xRg.Height)
    Next

I assume you have 40 sheets in the workbook. Also add the file names in xFiles variable.