Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
ActiveSheet.Pictures.Insert
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can't insert pictures | New Users to Excel | |||
Insert pictures | Excel Discussion (Misc queries) | |||
Need Help with auto insert of pictures | New Users to Excel | |||
Insert pictures | Excel Programming | |||
Activesheet.Pictures.Insert | Excel Programming |