compwize
01-14-2014, 06:26 PM
Hello everyone,
I'm new to this forum and have limited knowledge about scripting.
I have a folder located c:\Products\ that contains images
I have an excel sheet that i want to insert images from that folder listed above into column 1
I have the image file name in column two
I did some research and found the following script (you will see it below) that will insert the images into column 1
The script worked fine but it seams to me that the images folder has to be present in the root directory of c:\ for the person to view the images. Its like looking at the reference of the image location.
What i'm asking is, is there a way to insert this images like if you had used the insert image option in excel. So when i email the file to someone when they open it they find the images inserted without to have to send the images folder.
Regards,
Michael
Sub Picture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 2
Do While (Cells(lThisRow, 2) <> "")
pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted
picname = Cells(lThisRow, 2) 'This is the picture name
present = Dir("C:\Products\" & picname & ".jpg")
If present <> "" Then
ActiveSheet.Pictures.Insert("C:\Products\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With
Else
Cells(pasteAt, 1) = "No Picture Found"
End If
lThisRow = lThisRow + 1
Loop
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select
End Sub
I'm new to this forum and have limited knowledge about scripting.
I have a folder located c:\Products\ that contains images
I have an excel sheet that i want to insert images from that folder listed above into column 1
I have the image file name in column two
I did some research and found the following script (you will see it below) that will insert the images into column 1
The script worked fine but it seams to me that the images folder has to be present in the root directory of c:\ for the person to view the images. Its like looking at the reference of the image location.
What i'm asking is, is there a way to insert this images like if you had used the insert image option in excel. So when i email the file to someone when they open it they find the images inserted without to have to send the images folder.
Regards,
Michael
Sub Picture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 2
Do While (Cells(lThisRow, 2) <> "")
pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted
picname = Cells(lThisRow, 2) 'This is the picture name
present = Dir("C:\Products\" & picname & ".jpg")
If present <> "" Then
ActiveSheet.Pictures.Insert("C:\Products\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With
Else
Cells(pasteAt, 1) = "No Picture Found"
End If
lThisRow = lThisRow + 1
Loop
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select
End Sub