J
James8309
Hi everyone
I am trying to create a macro that will look at cell values in range
A1:A2 in sheet1 and insert the correct image on B1:B2.
I.e. values are 2 letters (either number of alphabet e.g. 2C, TH),
image files are value.gif (e.g. picture for TH = TH.GIF)
Path for those pictures are C:\My Documents\ but is it possible to
place all the pictures in sheet2 and look up in sheet2 or anywhere in
that workbook instead of opening the picture under that directory each
time it runs macro?
I have this code from another forum and trying to modify it but it
surely is difficult for me.
Can anyone help?
Thank you everyone!
Sub InsertGIF()
Dim myCell As Range, cell As Range
Dim shp As Shape, rng1 As Range
Dim shp1 As Picture
Dim s As String, sPath As String
Dim s2 As String
Set rng1 = Sheets("sheet1").Range("A1:A2")
Set myCell = Selection
sPath = "C:\My Documents\
If Not Intersect(myCell, rng1) Is Nothing Then
For Each cell In rng1
If cell.Value = "2C" Then
s2 = "2C.GIF"
ElseIf cell.Value = "3C" Then
s2 = "3C.GIf"
ElseIf cell.Value = "4C" Then
s2 = "4C.GIF"
ElseIf cell.Value = "5C" Then
s2 = "5C.GIF"
ElseIf cell.Value = "6C" Then
s2 = "6C.GIF"
End If
With shp1
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With
I am trying to create a macro that will look at cell values in range
A1:A2 in sheet1 and insert the correct image on B1:B2.
I.e. values are 2 letters (either number of alphabet e.g. 2C, TH),
image files are value.gif (e.g. picture for TH = TH.GIF)
Path for those pictures are C:\My Documents\ but is it possible to
place all the pictures in sheet2 and look up in sheet2 or anywhere in
that workbook instead of opening the picture under that directory each
time it runs macro?
I have this code from another forum and trying to modify it but it
surely is difficult for me.
Can anyone help?
Thank you everyone!
Sub InsertGIF()
Dim myCell As Range, cell As Range
Dim shp As Shape, rng1 As Range
Dim shp1 As Picture
Dim s As String, sPath As String
Dim s2 As String
Set rng1 = Sheets("sheet1").Range("A1:A2")
Set myCell = Selection
sPath = "C:\My Documents\
If Not Intersect(myCell, rng1) Is Nothing Then
For Each cell In rng1
If cell.Value = "2C" Then
s2 = "2C.GIF"
ElseIf cell.Value = "3C" Then
s2 = "3C.GIf"
ElseIf cell.Value = "4C" Then
s2 = "4C.GIF"
ElseIf cell.Value = "5C" Then
s2 = "5C.GIF"
ElseIf cell.Value = "6C" Then
s2 = "6C.GIF"
End If
With shp1
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With