Hi,
Please excuse my total ignorance in VBA, and I've tried multiple solutions myself but my fixes are making things worse.
I've found a wonderful bit of VBA here - Excel - A macro to insert pictures - which I'm using to import photographs en-mass from a folder into Excel. It works very well, but my problem is that the images can have either jpg, gif or jpeg file extensions. The photo import is working perfectly for jpg files, but what i want it to do is:
Try to import the file as a .jpg extension
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then try to import the file as a .gif extension (ErrorTryGif
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then try to import the file as a .jpeg extension (ErrorTryJpeg
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then go right to the end of the VBA where the 1ThisRow value is updated to +1 to move on to the next record, and go back to the start. (ErrorHandler
I don't think this should be too complicated but i have no idea what to put where to get this to work. Could someone please give me a clue what I need to fix in the VBA below?
JennyB
Please excuse my total ignorance in VBA, and I've tried multiple solutions myself but my fixes are making things worse.
I've found a wonderful bit of VBA here - Excel - A macro to insert pictures - which I'm using to import photographs en-mass from a folder into Excel. It works very well, but my problem is that the images can have either jpg, gif or jpeg file extensions. The photo import is working perfectly for jpg files, but what i want it to do is:
Try to import the file as a .jpg extension
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then try to import the file as a .gif extension (ErrorTryGif
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then try to import the file as a .jpeg extension (ErrorTryJpeg
If the file is imported correctly, then move on to resizing it, etc. (ResumeFromHere
If the import fails then go right to the end of the VBA where the 1ThisRow value is updated to +1 to move on to the next record, and go back to the start. (ErrorHandler
I don't think this should be too complicated but i have no idea what to put where to get this to work. Could someone please give me a clue what I need to fix in the VBA below?
JennyB
Code:
Sub GetPicture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 5
Do While (Cells(lThisRow, 2) <> "")
'Range("A6").Select 'This is where picture will be inserted
'pasteAt = Cells(lThisRow, 1)
Cells(lThisRow, 1).Select 'This is where picture will be inserted
'Dim picname As String
'picname = Range("B6") 'This is the picture name
picname = Cells(lThisRow, 17) 'This is the picture name"
On Error GoTo ErrorTryGif
ActiveSheet.Pictures.Insert("//location/" & picname & ".jpg").Select 'Path to where pictures are stored
GoTo ResumeFromHere
ResumeFromHere:
' 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 = 80#
.ShapeRange.Rotation = 0#
End With
ErrorHandler:
Resume Next
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("A1").Select
ErrorTryGif:
On Error GoTo ErrorTryJpeg
ActiveSheet.Pictures.Insert("//location/" & picname & ".gif").Select 'Path to where pictures are stored
GoTo ResumeFromHere
ErrorTryJpeg:
On Error GoTo ErrorHandler
ActiveSheet.Pictures.Insert("//location/" & picname & ".jpeg").Select 'Path to where pictures are stored
GoTo ResumeFromHere
End Sub
Last edited by a moderator: