Auto update image VBA

martinus1988

New Member
Joined
Aug 13, 2015
Messages
15
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).
Code:
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.
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,108
Office Version
  1. 365
Platform
  1. Windows
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.

Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,962
Messages
5,599,065
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top