| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Running out of memory when adding logos to reports
I am running Excel 2000 on XP. I have scripts that pull data from a
database and turn them into a number of reports. Each report is supposed to have our logo and the client's logo. I have the logos on a sheet in the excel book. After each sheet is formatted I call a routine to put the logos on. (see code below) A single run of formatting creates something in the neighborhood of 160 sheets in 47 books. If I remove adding the logos everything works fine. Infact I reran the formating so many times that I was opening "Book 423" withought error. If the adding logos in included the process gets through about 35 sheets and then I get an error on a line that says "cannot set the PrintTitleColumns field" and points to the line :"ActiveSheet.PageSetup.PrintTitleColumns = """ Obviousely this line is NOT the problem. Here is how I am adding the logos. Is there a better way? Am I missing something in here? Sub addLogo(lastcol As Integer) Dim left As Integer Dim top As Integer Dim height As Integer Dim width As Integer Dim hscale As Double Dim vscale As Double Dim fscale As Double Sheets("Logos").Shapes("MyLogo").Copy With Range(Cells(1, lastcol - 2), Cells(4, lastcol)) left = .left top = .top height = .height width = .width End With Range(Cells(1, lastcol - 2), Cells(4, lastcol)).PasteSpecial Selection.Name = "MyLogo" vscale = width / ActiveSheet.Shapes.Range("MyLogo").width hscale = height / ActiveSheet.Shapes.Range("MyLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("MyLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("MyLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("MyLogo").left = (left + width) - ActiveSheet.Shapes.Range("MyLogo").width - 5 ActiveSheet.Shapes.Range("MyLogo").top = top Sheets("Logos").Shapes("ClientLogo").Copy With Range(Cells(1, 1), Cells(4, 3)) left = .left top = .top height = .height width = .width End With Range(Cells(1, 1), Cells(4, 3)).PasteSpecial Selection.Name = "ClientLogo" vscale = width / ActiveSheet.Shapes.Range("ClientLogo").width hscale = height / ActiveSheet.Shapes.Range("ClientLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("ClientLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("ClientLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("ClientLogo").left = left + 5 ActiveSheet.Shapes.Range("ClientLogo").top = top End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Running out of memory when adding logos to reports
Maybe a solution is to add the logo in the Worksheet_Activate event and
remove it in the Worksheet_Deactivate event. So, there is only one logo at any one time. RBS wrote in message oups.com... I am running Excel 2000 on XP. I have scripts that pull data from a database and turn them into a number of reports. Each report is supposed to have our logo and the client's logo. I have the logos on a sheet in the excel book. After each sheet is formatted I call a routine to put the logos on. (see code below) A single run of formatting creates something in the neighborhood of 160 sheets in 47 books. If I remove adding the logos everything works fine. Infact I reran the formating so many times that I was opening "Book 423" withought error. If the adding logos in included the process gets through about 35 sheets and then I get an error on a line that says "cannot set the PrintTitleColumns field" and points to the line :"ActiveSheet.PageSetup.PrintTitleColumns = """ Obviousely this line is NOT the problem. Here is how I am adding the logos. Is there a better way? Am I missing something in here? Sub addLogo(lastcol As Integer) Dim left As Integer Dim top As Integer Dim height As Integer Dim width As Integer Dim hscale As Double Dim vscale As Double Dim fscale As Double Sheets("Logos").Shapes("MyLogo").Copy With Range(Cells(1, lastcol - 2), Cells(4, lastcol)) left = .left top = .top height = .height width = .width End With Range(Cells(1, lastcol - 2), Cells(4, lastcol)).PasteSpecial Selection.Name = "MyLogo" vscale = width / ActiveSheet.Shapes.Range("MyLogo").width hscale = height / ActiveSheet.Shapes.Range("MyLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("MyLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("MyLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("MyLogo").left = (left + width) - ActiveSheet.Shapes.Range("MyLogo").width - 5 ActiveSheet.Shapes.Range("MyLogo").top = top Sheets("Logos").Shapes("ClientLogo").Copy With Range(Cells(1, 1), Cells(4, 3)) left = .left top = .top height = .height width = .width End With Range(Cells(1, 1), Cells(4, 3)).PasteSpecial Selection.Name = "ClientLogo" vscale = width / ActiveSheet.Shapes.Range("ClientLogo").width hscale = height / ActiveSheet.Shapes.Range("ClientLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("ClientLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("ClientLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("ClientLogo").left = left + 5 ActiveSheet.Shapes.Range("ClientLogo").top = top End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Running out of memory when adding logos to reports
Some things to try/note... 1. Use CopyPicture instead of Copy 2. Use Paste instead of PasteSpecial 3. Have the original logos already sized so the code doesn't have to do it. 4. Don't use variables with names that Excel already uses... "width,height,left, right" 5. The size/placement dimensions are in points (Long not Integer). 6. If you have to size them use what's there... (who cares if the size differs slightly) With ActiveSheet.Shapes(1) .Width = ActiveSheet.Range(xx).Width .Left = ActiveSheet.Range(xx).Left End With -- Jim Cone San Francisco, USA http://www.realezsites.com/bus/primitivesoftware wrote in message I am running Excel 2000 on XP. I have scripts that pull data from a database and turn them into a number of reports. Each report is supposed to have our logo and the client's logo. I have the logos on a sheet in the excel book. After each sheet is formatted I call a routine to put the logos on. (see code below) A single run of formatting creates something in the neighborhood of 160 sheets in 47 books. If I remove adding the logos everything works fine. Infact I reran the formating so many times that I was opening "Book 423" withought error. If the adding logos in included the process gets through about 35 sheets and then I get an error on a line that says "cannot set the PrintTitleColumns field" and points to the line :"ActiveSheet.PageSetup.PrintTitleColumns = """ Obviousely this line is NOT the problem. Here is how I am adding the logos. Is there a better way? Am I missing something in here? Sub addLogo(lastcol As Integer) Dim left As Integer Dim top As Integer Dim height As Integer Dim width As Integer Dim hscale As Double Dim vscale As Double Dim fscale As Double Sheets("Logos").Shapes("MyLogo").Copy With Range(Cells(1, lastcol - 2), Cells(4, lastcol)) left = .left top = .top height = .height width = .width End With Range(Cells(1, lastcol - 2), Cells(4, lastcol)).PasteSpecial Selection.Name = "MyLogo" vscale = width / ActiveSheet.Shapes.Range("MyLogo").width hscale = height / ActiveSheet.Shapes.Range("MyLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("MyLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("MyLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("MyLogo").left = (left + width) - ActiveSheet.Shapes.Range("MyLogo").width - 5 ActiveSheet.Shapes.Range("MyLogo").top = top Sheets("Logos").Shapes("ClientLogo").Copy With Range(Cells(1, 1), Cells(4, 3)) left = .left top = .top height = .height width = .width End With Range(Cells(1, 1), Cells(4, 3)).PasteSpecial Selection.Name = "ClientLogo" vscale = width / ActiveSheet.Shapes.Range("ClientLogo").width hscale = height / ActiveSheet.Shapes.Range("ClientLogo").height fscale = 1 If (hscale <= vscale And hscale < 1) Then fscale = hscale ElseIf (vscale < hscale And vscale < 1) Then fscale = vscale End If ActiveSheet.Shapes.Range("ClientLogo").ScaleWidth fscale, msoFalse, msoScaleFromBottomRight ActiveSheet.Shapes.Range("ClientLogo").ScaleHeight fscale, msoFalse, msoScaleFromTopLeft ActiveSheet.Shapes.Range("ClientLogo").left = left + 5 ActiveSheet.Shapes.Range("ClientLogo").top = top End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Copy/Paste - Running out of Memory | New Users to Excel | |||
| Running updates reports automatically | Excel Programming | |||
| Running out of memory | Excel Programming | |||
| XP running out of memory when using macro | Excel Programming | |||
| Not enough Memory running macro | Excel Programming | |||
Hybrid Mode
