Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 7
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can't insert pictures laurie New Users to Excel 2 April 5th 23 01:21 PM
Insert pictures AZU Excel Discussion (Misc queries) 5 March 6th 09 05:28 PM
Need Help with auto insert of pictures Bradley Wolosz New Users to Excel 3 August 25th 08 12:28 PM
Insert pictures TheRook Excel Programming 4 August 11th 06 02:58 PM
Activesheet.Pictures.Insert dchow Excel Programming 2 September 24th 03 07:22 PM


All times are GMT +1. The time now is 10:20 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"