Insert Picture from Directory on Cell Value Changed by Formula

[dtj]

Dear All,

I have a following macro that finds from directory and shows in cell "G29" a picture when i manually change cell "G28" value. Problem is that cell "G28" is updated by formula and when value is changed picture doesn't update automatically.
Below is the code used, is there any way I can make picture change automatically ?

Private Sub Worksheet_Change(ByVal Target As Range)


Dim myPict As Picture
Dim PictureLoc As String


If Target.Address = Range("G28").Address Then


ActiveSheet.Pictures.Delete


PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("G28").Value & ".png"


With Range("G29")
Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With


End If


End Sub


Thank you in advance

[paulked]

Hi and welcome to the forum.

Try it with Worksheet_Calculate rather than Worksheet_Change event.

[dtj]

Hi and welcome to the forum.

Try it with Worksheet_Calculate rather than Worksheet_Change event.


Hi paulked, I'm starter in vba, so can't exactly know how to do it. Is this simple enough to write how the macro should be ?

Thanks once again

[paulked]

Private Sub Worksheet_Calculate()


Dim myPict As Picture
Dim PictureLoc As String


If Target.Address = Range("G28").Address Then


ActiveSheet.Pictures.Delete


PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("G28").Value & ".png"


With Range("G29")
Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With


End If


End Sub

[paulked]

Sorry, that may not work... let me have a quick look!

[dtj]

Ok thanks but it now shows error '424' -object required

[paulked]

This in the Sheet Module (in place of the code you have in your 1st post.



Option Explicit

Private OldVal As Double

Private Sub Worksheet_Calculate()
Dim myPict As Picture
Dim PictureLoc As String
If Range("G28") <> OldVal Then
ActiveSheet.Pictures.Delete
PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("G28").Value & ".png"
With Range("G29")
Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
End If
OldVal = Range("G28")
End Sub

[dtj]

First of all thank you for your quick replies.
It now shows error 13 - type missmatch, but it shows the picture though.

Also why is this image is shown also in another sheet now ?

[paulked]

Can you post your workbook?

[dtj]

Can you post your workbook?
Sure, here it is

[paulked]

The code should go with your button code like in the attached updated workbook.

[dtj]

The code should go with your button code like in the attached updated workbook.
Sorry, it now says runtime "error 1004 - unable to get the insert property of the pictures class". :crying:

[paulked]

Sorry, I missed the sheet reference from the image. Add the bit in red.



PictureLoc = "C:\\Users\Admin\Desktop\images" & Sheets("order 760").Range("G28").Value & ".png"

[dtj]

I think we (most probably i should say you) are in the last step... Now when i insert a key and press button picture is shown but when i insert another key picture is not updated. But if i go back and press button again then picture changes.

[paulked]

Move your "worksheet" code to the top:



Sub Button10_Click()
Worksheets("master").Range("AG3").Copy _
Worksheets("order 760").Range("A2")
Worksheets("master").Visible = True
Worksheets("order 760").Activate
Dim myPict As Picture
Dim PictureLoc As String
Sheets("order 760").Pictures.Delete
PictureLoc = "C:\\Users\Admin\Desktop\images" & Sheets("order 760").Range("G28").Value & ".png"
With Sheets("order 760").Range("G29")
Set myPict = Sheets("order 760").Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
End Sub

[dtj]

YOU ARE THE MAN !

I name you VBAX Grand Master :clap:

Thank you SO much !

[paulked]

Just learning. You can mark this solved, thread tools at the top.

:thumb

[dtj]

Just learning. You can mark this solved, thread tools at the top.

:thumb
Dear paulked,

Is there any way to show message when picture is not found, instead of getting Run-time error ?
5.28 in the morning and still working on file from last time we spoke..:wot

[paulked]

Sub Button10_Click()
Worksheets("master").Range("AG3").Copy _
Worksheets("order 760").Range("A2")
Worksheets("master").Visible = True
Worksheets("order 760").Activate
Dim myPict As Picture
Dim PictureLoc As String
Sheets("order 760").Pictures.Delete
PictureLoc = "C:\\Users\Admin\Desktop\images" & Sheets("order 760").Range("G28").Value & ".png"
On Error GoTo Oops
With Sheets("order 760").Range("G29")
Set myPict = Sheets("order 760").Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
Exit Sub
Oops:
MsgBox "Sorry, couldn't find that image.", , "No image..."
End Sub

[dtj]

Sub Button10_Click()
Worksheets("master").Range("AG3").Copy _
Worksheets("order 760").Range("A2")
Worksheets("master").Visible = True
Worksheets("order 760").Activate
Dim myPict As Picture
Dim PictureLoc As String
Sheets("order 760").Pictures.Delete
PictureLoc = "C:\\Users\Admin\Desktop\images" & Sheets("order 760").Range("G28").Value & ".png"
On Error GoTo Oops
With Sheets("order 760").Range("G29")
Set myPict = Sheets("order 760").Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
Exit Sub
Oops:
MsgBox "Sorry, couldn't find that image.", , "No image..."
End Sub

yesss:bow:

[paulked]

:thumb