Inserting Images into Worksheets / VBA Loop Active Sheets

owlfeather · Dec 20th 2018

Hello all,
thanks already in advance to try and help me with this.
I have a formula that inserts images based on a cell and it works fine if I activate this for the different Sheets individually -
now is there a way to apply this to all worksheets at the same time?

Code

Sub Picture()
Range("A1").Select
Dim picname As String
picname = "G:\BUYING\Non Food\EK-VK Kalkulation\2019\6\SO" & Range("B4") & "_VTF.jpg" 'Link to the picture
ActiveSheet.Pictures.Insert(picname).Select
With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 500#
.ShapeRange.Width = 750#
.ShapeRange.Rotation = 0#
End With
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("P20").Select


End Sub

Display More

**norie** · Dec 20th 2018

Try this.

Code

Option Explicit


Sub AddPicture()
Dim ws As Worksheet
Dim picname As String


    For Each ws In ActiveWorkbook.Sheets


        picname = "G:\BUYING\Non Food\EK-VK Kalkulation\2019\6\SO" & ws.Range("B4") & "_VTF.jpg"    'Link to the picture


        ws.Pictures.Insert picname


        With ws.Pictures(ws.Pictures.Count)
            .Left = ws.Range("A1").Left
            .Top = ws.Range("A1").Top
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 500#
            .ShapeRange.Width = 750#
            .ShapeRange.Rotation = 0#
        End With
    
    Next ws
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrNoPhoto:
    MsgBox "Unable to Find Photo"    'Shows message box if picture not found
    Exit Sub
    Range("P20").Select


End Sub

Display More

owlfeather · Dec 21st 2018

Hello

- unfortunately this gives me an error message -

Run-time Error 1004 / Application defined or object defined error!

owlfeather · Dec 21st 2018

Hello

- unfortunately this gives me an error message -
Run-time Error 1004 / Application defined or object defined error!

owlfeather · Dec 21st 2018

Hello
- unfortunately this gives me an error message -
Run-time Error 1004 / Application defined or object defined error!

owlfeather · Dec 21st 2018

Hello
- unfortunately this gives me an error message -
Run-time Error 1004 / Application defined or object defined error

Is there maybe another way to automatically add images per sheet based on a cell in B4 (image name) and insert in A1?

Inserting Images into Worksheets / VBA Loop Active Sheets

Participate now!

Share