![]() |
Better way to delete macros & other components???
I'm a newbie at this so please be tolerant of the incorrect terminology
as I try to explain what I need. I have created a purchase order form in Excel 97 using macros for automatic numbering, data verification, printing, saving, etc. Not knowing how to incorporate a database for data entry I created the worksheet three pages long which covers orders from 1 to 60 items in size. On each page I imbedded graphics (logos) and created a "Save" button and "Print" button which execute a data verification macro before saving or printing. Each page also has a "Help" button. The "Save" button automatically assigns a filename and saves the file to our file server for permanent storage. The saved files don't need the buttons or macros so I decided to delete any unused pages, remove all buttons and delete all macros. The problem is that it is taking a long time to save a file. I'm looking for better ways to do the clean-up. Any suggestions would be appreciated. Here is what I am doing... For deleting buttons I use: ActiveSheet.Shapes("Button 10").Select Selection.Cut I have 12 of these. For deleting extra pages I check the first data cell of each page and delete the page if that cell is blank as follows: ===code starts=== If Range(strP2DataCell1) = "" Then If Range(strP2DataCell2) = "" Then intCounter = strP2FirstRow Do Until intCounter strP3LastRow Worksheets(1).Rows(strP2FirstRow).Delete intCounter = intCounter + 1 Loop ' Delete embedded MS Word Objects (DECC logo on pages 2 and 3) ActiveSheet.Shapes("Object 36").Select Selection.Cut ActiveSheet.Shapes("Object 43").Select Selection.Cut End If 'If the first two "Quantity" fields on Page 3 are blank then delete all 'rows that make up page 3 ElseIf Range(strP3DataCell1) = "" Then If Range(strP3DataCell2) = "" Then intCounter = strP3FirstRow Do Until intCounter strP3LastRow Worksheets(1).Rows(strP3FirstRow).Delete intCounter = intCounter + 1 Loop ' Delete embedded MS Word Objects (DECC logo on pages 3) ActiveSheet.Shapes("Object 43").Select Selection.Cut End If End If ===code ends=== For deleting macros I use code that probably came from help from this group.<g This is not my code: ===code begins=== If objDocument Is Nothing Then Exit Sub i = 0 On Error Resume Next i = objDocument.VBProject.VBComponents.Count On Error GoTo 0 If i < 1 Then ' no VBComponents or protected VBProject MsgBox "The VBProject in " & objDocument.Name & _ " is protected or has no components!", _ vbInformation, "Remove All Macros" Exit Sub End If With objDocument.VBProject For i = .VBComponents.Count To 1 Step -1 On Error Resume Next .VBComponents.Remove .VBComponents(i) ' delete the component On Error GoTo 0 Next i End With With objDocument.VBProject For i = .VBComponents.Count To 1 Step -1 l = 1 On Error Resume Next l = .VBComponents(i).CodeModule.CountOfLines .VBComponents(i).CodeModule.DeleteLines 1, l ' clear lines On Error GoTo 0 Next i End With ===code ends=== Much thanks, BrianG |
Better way to delete macros & other components???
Inline
wrote in message ups.com... I'm a newbie at this so please be tolerant of the incorrect terminology as I try to explain what I need. I have created a purchase order form in Excel 97 using macros for automatic numbering, data verification, printing, saving, etc. Not knowing how to incorporate a database for data entry I created the worksheet three pages long which covers orders from 1 to 60 items in size. On each page I imbedded graphics (logos) and created a "Save" button and "Print" button which execute a data verification macro before saving or printing. Each page also has a "Help" button. The "Save" button automatically assigns a filename and saves the file to our file server for permanent storage. The saved files don't need the buttons or macros so I decided to delete any unused pages, remove all buttons and delete all macros. The problem is that it is taking a long time to save a file. I'm looking for better ways to do the clean-up. Any suggestions would be appreciated. Here is what I am doing... For deleting buttons I use: ActiveSheet.Shapes("Button 10").Select Selection.Cut I have 12 of these. Activesheet.Buttons.Delete For deleting extra pages I check the first data cell of each page and delete the page if that cell is blank as follows: ===code starts=== If Range(strP2DataCell1) = "" Then If Range(strP2DataCell2) = "" Then intCounter = strP2FirstRow Do Until intCounter strP3LastRow Worksheets(1).Rows(strP2FirstRow).Delete intCounter = intCounter + 1 Don't you know how many rows there are Rows(strP2FirstRow).Resize(strP3LastRow-strP2FirstRow+1).Delete Loop ' Delete embedded MS Word Objects (DECC logo on pages 2 and 3) ActiveSheet.Shapes("Object 36").Select Selection.Cut ActiveSheet.Shapes("Object 43").Select Selection.Cut End If 'If the first two "Quantity" fields on Page 3 are blank then delete all 'rows that make up page 3 ElseIf Range(strP3DataCell1) = "" Then If Range(strP3DataCell2) = "" Then intCounter = strP3FirstRow Do Until intCounter strP3LastRow Worksheets(1).Rows(strP3FirstRow).Delete intCounter = intCounter + 1 Same concept as above Loop ' Delete embedded MS Word Objects (DECC logo on pages 3) ActiveSheet.Shapes("Object 43").Select Selection.Cut End If End If ===code ends=== For deleting macros I use code that probably came from help from this group.<g This is not my code: ===code begins=== If objDocument Is Nothing Then Exit Sub i = 0 On Error Resume Next i = objDocument.VBProject.VBComponents.Count On Error GoTo 0 If i < 1 Then ' no VBComponents or protected VBProject MsgBox "The VBProject in " & objDocument.Name & _ " is protected or has no components!", _ vbInformation, "Remove All Macros" Exit Sub End If With objDocument.VBProject For i = .VBComponents.Count To 1 Step -1 On Error Resume Next .VBComponents.Remove .VBComponents(i) ' delete the component On Error GoTo 0 Next i End With With objDocument.VBProject For i = .VBComponents.Count To 1 Step -1 l = 1 On Error Resume Next l = .VBComponents(i).CodeModule.CountOfLines .VBComponents(i).CodeModule.DeleteLines 1, l ' clear lines On Error GoTo 0 Next i End With ===code ends=== Much thanks, BrianG -- Regards, Tom Ogilvy |
All times are GMT +1. The time now is 07:18 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com