J
John
I have been using a VBA module for several years in XL 7 but crashes in
2013. Even when I step thru the code, it will crash about 50% of the way.
The code basically inserts 24 photos into a spreadsheet for printing. It
also includes date and photo ID. The code is attached. Please, any advice??
Sub InsertPhotosNew()
Dim Msg As String
Dim Directory As String, f As String
Dim x As Long
Dim y As Long
Dim r As Long
Dim c As Long
Dim wks As Worksheet
Set wks = ActiveSheet
Msg = "Select a location containing the files you want to list."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
ActiveSheet.Range("j1") = Directory
' Get first file
f = Dir(Directory, vbReadOnly)
r = 2
Do While f <> ""
c = 1
For y = 30 To 635 Step 121
r = r + 2
For x = 10 To 430 Step 140
If Directory = "" Then Exit Sub
ActiveSheet.Shapes.AddPicture Directory & f, _
True, False, x, y, 130, 100
Cells(r, c) = f
Cells(r, c + 1) = FileDateTime(Directory & f)
f = Dir
c = c + 2
Next x
c = 1
Next y
Loop
End Sub
2013. Even when I step thru the code, it will crash about 50% of the way.
The code basically inserts 24 photos into a spreadsheet for printing. It
also includes date and photo ID. The code is attached. Please, any advice??
Sub InsertPhotosNew()
Dim Msg As String
Dim Directory As String, f As String
Dim x As Long
Dim y As Long
Dim r As Long
Dim c As Long
Dim wks As Worksheet
Set wks = ActiveSheet
Msg = "Select a location containing the files you want to list."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
ActiveSheet.Range("j1") = Directory
' Get first file
f = Dir(Directory, vbReadOnly)
r = 2
Do While f <> ""
c = 1
For y = 30 To 635 Step 121
r = r + 2
For x = 10 To 430 Step 140
If Directory = "" Then Exit Sub
ActiveSheet.Shapes.AddPicture Directory & f, _
True, False, x, y, 130, 100
Cells(r, c) = f
Cells(r, c + 1) = FileDateTime(Directory & f)
f = Dir
c = c + 2
Next x
c = 1
Next y
Loop
End Sub