Auto update image VBA

[martinus1988]

Hi all,

It is probably simple, but could not figure it out.
The macro that i use is for getting product images for quotations.
The only problem is that i want it to autoupdate. (Now i have to click button to see images on sheet, before sending quote).

Sub AfbeeldingenOfferte()
picname1 = Range("E13") 'This is the picture name
picname2 = Range("E19") 'This is the picture name
picname3 = Range("E25") 'This is the picture name
picname4 = Range("E31") 'This is the picture name
picname5 = Range("E37") 'This is the picture name
picname6 = Range("E43") 'This is the picture name
picname7 = Range("E49") 'This is the picture name
picname8 = Range("E55") 'This is the picture name
picname9 = Range("E61") 'This is the picture name
picname10 = Range("E67") 'This is the picture name


    InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname1 & ".png", _
        Range("B13:B17")
    InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname2 & ".png", _
        Range("B19:B23")
    InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname3 & ".png", _
        Range("B25:B29")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname4 & ".png", _
        Range("B31:B35")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname5 & ".png", _
        Range("B37:B41")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname6 & ".png", _
        Range("B43:B47")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname7 & ".png", _
        Range("B49:B53")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname8 & ".png", _
        Range("B55:B59")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname9 & ".png", _
        Range("B61:B65")
        InsertPictureInRange "C:\Users\info\Desktop\Offertes\Product images\" & picname10 & ".png", _
        Range("B67:B71")
        
End Sub


Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCells
        t = .Top + 1
        l = .Left + 1
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
End Sub

Thank you for helping.

 

[Kenneth Hobson]

I guess it depends on what event you want to trigger it. For one of these two methods or both, add in the ThisWorkbook object.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  AfbeeldingenOfferte
End Sub

Private Sub Workbook_Open()
  AfbeeldingenOfferte
End Sub

I would recommend modifying AfbeeldingenOfferte using an array and a loop to make it easier to maintain and a bit more efficient.