PDA

View Full Version : Insert Picture With Cell Reference In Excel VBA Dont Show In Other Computers (Help)



fehmizcan107
10-24-2018, 12:01 AM
Hi,

To create my organization chart I needed to insert pictures to BT2:BV2 cell using ID number as reference in cell D2 from a folder on which employee photos saved as IDnumber.jpg.
I know almost nothing about macros but I could figure out to find below code and create my organization chart
The problem is when I send the chart to other people, the photos disappear since it is not embedded but linked.
Can anyone Kindly help me to correct my code?


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Dim myPict As Picture

With Range("bt2:bv2")
Set myPict = Range("bt2:bv2").Parent.Pictures.Insert("N:\Organization Chart\Pictures" & Target.Value & ".jpg")
myPict.Top = .Top
myPict.Width = .Width
myPict.Height = .Height
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With

End Sub

Kenneth Hobs
10-24-2018, 07:42 AM
Welcome to the forum!

Please paste code between code tags. Click the # icon on the reply toolbar to insert those tags.

The file name is Pictures plus some IDnumber.jpg? Maybe Pictures is a subfolder?

I would suggest adding code to Name the picture object so that you can delete it before insert/add.

Use the sheet's Shape object and AddPicture method. It allows links or embedded shape objects.

Not fully fleshed out but this should give you an idea.

Sub Main()
Dim s As Shape, r As Range, pic As String
pic = "c:\temp\Ken.jpg"
Set r = Sheet1.Range("BT2:BV2")
Set s = Sheet1.Shapes.AddPicture(pic, _
msoFalse, msoCTrue, r.Left, r.Top, r.Width, r.RowHeight)
s.Name = "Ken"
End Sub

fehmizcan107
10-24-2018, 09:05 AM
Thank you Mr Hobs,

"N:\Organization Chart\Pictures" is the folder where I keep pictures.
For example if employee ID is 14048,I keep it as "N:\Organization Chart\Pictures\14048.jpg"
And I want to insert employee's photo to "BT2:BV2" when I type ID number in "D2"
So when I type "14048" in "D2" cell,I want "14048.jpg" to be inserted.When I type "7698",I want "7698.jpg" to be inserted.

I couldn't understand how can I use D2 cell connection with your code.
Or is there any possibility that I can add embed action to my code?

Kenneth Hobs
10-24-2018, 11:59 AM
I have not tested it but it should go something like:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub

Dim s As Shape, p As String
With Range("BT2:BV2")
On Error Resume Next
ActiveSheet.Shapes("ID").Delete
On Error GoTo 0
p = "N:\Organization Chart\Pictures\" & Target.Value & ".jpg"
Set s = ActiveSheet.Shapes.AddPicture(p, msoFalse, msoCTrue, .Left, .Top, .Width, .RowHeight)
s.Name = "ID"
End With
End Sub

fehmizcan107
10-25-2018, 12:07 AM
Great !Thank you very much.

This solved the issue well.I tested it and now we can see the photos in other computers also.

For a second step improvement,I wonder if there is any possibility to extend this code for row 2 completely.
Example : Type ID in "E2" and get picture in "E2",type ID in "F2" and get picture in "F2" ........... type ID in "Z2" and get picture in "Z2"

fehmizcan107
10-25-2018, 10:09 PM
Hi

I could write the code with trial-error method.Sharing for people who may need
Thanks for your supports

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("9:9")) Is Nothing Then Exit Sub

Dim s As Shape, p As String
With Target.Offset(1, 0)
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
On Error Resume Next
On Error GoTo 0
p = "N:\Org Dev Pln Dpt\OPR R_OD\OPR R_OD_OD\Leader Studies\gl posts study\TMMT" & Target.Value & ".jpg"
Set s = ActiveSheet.Shapes.AddPicture(p, msoFalse, msoCTrue, .Left, .Top, .Width, .RowHeight)
s.Name = "ID"
End With
End Sub