Using Excel Macro to insert jpeg from dir

Hello,

Please help.


I have written a macro to pickup jpeg file from the directory and insert it into excel. I have issue with picking up jpeg file from the directory.

the error I get is Run-time error '1004'
Unable to get the insert property of the pictures class.

When I select Debug it select the line:-


ActiveSheet.Pictures.Insert("Z:\ACCDATA\IMAGES\" & picname & ".JPEG").Select 'Path to where pictures are stored


All the images are in the images subdirectory and they are all have JPEG file extention.



Thanks




My macro is



Sub test()

'''''''''''''''' insert_col in Col A and change the width'''''''''''''''

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 25
Selection.ColumnWidth = 31

''''''''''''''' End inserting col'''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Insert image of the picture from Col.B into Col.A
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long


lThisRow = 2

Do While (Cells(lThisRow, 2) <> "")

'Range("A6").Select 'This is where picture will be inserted
'pasteAt = Cells(lThisRow, 3)
pasteAt = lThisRow 'This is where picture will be inserted

'Dim picname As String
'picname = Range("B6") 'This is the picture name
picname = Cells(lThisRow, 2) 'This is the picture name


ActiveSheet.Pictures.Insert("Z:\ACCDATA\IMAGES" & picname & ".JPEG").Select 'Path to where pictures are stored


'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection

Cells.Select
Selection.RowHeight = 75

.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top


.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 70#
.ShapeRange.Width = 60#
.ShapeRange.Rotation = 0#


End With

lThisRow = lThisRow + 1

Loop



Range("A10").Select
Application.ScreenUpdating = True


''''''''''''''' insert 6 rows at the top of the sheet''''''''''''''
Rows("1:9").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
''''''''''''''' End 6 rows at the top of the sheet''''''''''''''
'''''''''''''''reduce hight from A1:A7''''''''''''''
Rows("1:9").Select
Range("A7").Activate
Selection.RowHeight = 27
Range("A2").Select
'''''''''''''''End reduce hight from A1:A7''''''''''''''
''''''''''''''' change Row hight and ColumnWidth ''''''''''''''
Rows("10:6700").Select
Selection.RowHeight = 75
Selection.ColumnWidth = 20
''''''''''''''' End of change Row hight and ColumnWidth ''''''''''''''


'Delete columns
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft


'''changing the format of the column heading to center and change font to 12

Rows("10:10").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False

End With


Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'''End complete format

Range("C1").Select
ActiveCell.FormulaR1C1 = "Test"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Test"
Range("C3").Select
ActiveCell.FormulaR1C1 = "test"


'''Sub currenttime1()
t = Time()
d = Date
Set Displaytime = Sheets(1).Range("d3")
Displaytime.Cells(1, 1) = Str(d) + " at " + Str(t)
Columns("d:D").AutoFit
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Regular"
'.Size = 14

.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1

End With
Rows("4:4").EntireRow.AutoFit


Range("C1:D3").Select
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone

End With
Selection.Font.Bold = True



''''End Sub currenttime1()


Range("A5").Select
ActiveCell.FormulaR1C1 = "Contact Details"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With
Range("B5").Select
ActiveCell.FormulaR1C1 = "Phone"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With
Range("C5").Select
ActiveCell.FormulaR1C1 = "Email"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With

Range("A7").Select
ActiveCell.FormulaR1C1 = "Test"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With
Range("B7").Select
ActiveCell.FormulaR1C1 = "00000"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With
Range("C7").Select
ActiveCell.FormulaR1C1 = "Test"
With ActiveCell.Characters(Start:=1, Length:=24).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With

Range("A8").Select
ActiveCell.FormulaR1C1 = "Test"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With
Range("B8").Select
ActiveCell.FormulaR1C1 = "0000000"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Range("C8").Select
ActiveCell.FormulaR1C1 = "xxxxxxxxx"
With ActiveCell.Characters(Start:=1, Length:=24).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic

End With


Range("A5:D5").Select
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone

End With
Selection.Font.Bold = True

Exit Sub




''''''''''''''''''''''''''''''''''''''''''''''''''''''
'End Inserting image of the picture from Col.B into Col.A
''''''''''''''''''''''''''''''''''''''''''''''''''''''

ErrNoPhoto:
MsgBox "There is no more image to insert!" 'Shows message box if picture not found
Exit Sub
Range("B20").Select
End Sub