ActiveSheet.Pictures.Insert

[Sean McPoland]

I cannot get the following code to work in xL2K7.

The pictures never appear at the appropriate location - infact they just
overwrite each other, can someone tell me what is wrong - it used to work in
xL2K3

WS2K3SP1
OEnterprise@K7

thanks and regards
Sean

Public gposH As Integer
Public gposV As Integer
Public Const gHSize = 11
Public Const gVSize = 7
Public Const graphDirectory = "D:\outputgraphs\Pages" & "\"
Public FileIsTodaysDate As Boolean

Sub doNewGraphs()

Sheets("NewGraphs").Select

Cells.Select
Selection.Clear

For Each xImage In ActiveSheet.Pictures
xImage.Delete
Next xImage

gposH = 0
gposV = 0
'do the host first
'but not yet possible

performGetGraphs_refresh "NewGraphs" ' now only server where over 40%
that is we process all
' performGetGraphs_refresh "ServersToGraph" previous version selected
servers only

Range("A1").Select
Sheets(1).Select

End Sub

Sub performGetGraphs_refresh(work_sheet)

irow = 1
iCol = 2

Sheets(work_sheet).Select

Dim fs, fl, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set fl = fs.GetFolder(graphDirectory)
Set fc = fl.Files
For Each f1 In fc

If Right(f1.Name, 3) = "png" Then

filespec = graphDirectory & "\" & f1.Name

Set f = fs.GetFile(filespec)
s = UCase(filespec) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
Debug.Print s
' Debug.Print Now()

If Left(f.DateLastModified, 10) = Left(Now(), 10) Then
FileIsTodaysDate = True
Else
FileIsTodaysDate = False
End If

If FileIsTodaysDate Then

Select Case gposH

Case 0
gposH = 1
gposV = 1

Case 1
gposH = 5

Case 5
gposH = 10

Case Else
gposH = 1
gposV = gposV + 12

End Select

Range(Cells(gposV, gposH), Cells(gposV, gposH)).Select

ActiveSheet.Pictures.Insert(filespec).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 150#
Selection.ShapeRange.Width = 200
Selection.ShapeRange.Rotation = 0#

Else
End If

Sheets(work_sheet).Select
irow = irow + 1

Else
End If

Next

Set f1 = Nothing
Set fc = Nothing
Set fl = Nothing
Set fs = Nothing

End Sub