|
Problem with save some code
Hi,
I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
Hi ole,
That code looks familiar <G. Do you have both of those BeforeSave events in both workbooks? If not, why are you showing us two? -- HTH RP (remove nothere from the email address if mailing direct) "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
You have to disable events before you do your save.
Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub Use the above code to save your workbook after you put in the code. -- Regards, Tom Ogilvy "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
It's not working, i put it in "thisworkbook" but it only saves your code,
and mine code is still activated so if i say yes to save it erases my commandbuttons, heres how i put it in: Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub __________________________________________________ __________________________ __ Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Husk og brug 'Gem Som' når du gemmer denne fil", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub "Tom Ogilvy" skrev i en meddelelse ... You have to disable events before you do your save. Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub Use the above code to save your workbook after you put in the code. -- Regards, Tom Ogilvy "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
You should put it in a general module
You should then go back to excel and do Tools=Macro=Macros select SaveWorkbook and click run You should not select save or save as using the menus. You should use the macro to save the file by executing the macro, not saving from the menu. -- Regards, Tom Ogilvy "ole_" wrote in message ... It's not working, i put it in "thisworkbook" but it only saves your code, and mine code is still activated so if i say yes to save it erases my commandbuttons, heres how i put it in: Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub __________________________________________________ __________________________ __ Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Husk og brug 'Gem Som' når du gemmer denne fil", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub "Tom Ogilvy" skrev i en meddelelse ... You have to disable events before you do your save. Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub Use the above code to save your workbook after you put in the code. -- Regards, Tom Ogilvy "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
yes and no, i was trying to use "enableEvents = False" so that i have a
chance ro save my code without deleting my commandbuttons, i think i used it in my national file when i created it. but i was trying so many things, an suddently it worked i was just jumoing up an down of joy and did not now how i did it. But your code works perfecly :-) Ole "Bob Phillips" skrev i en meddelelse ... Hi ole, That code looks familiar <G. Do you have both of those BeforeSave events in both workbooks? If not, why are you showing us two? -- HTH RP (remove nothere from the email address if mailing direct) "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
BRILLIANT, thanks a lot, now im not getting completly bald:-)
Ole "Tom Ogilvy" skrev i en meddelelse ... You should put it in a general module You should then go back to excel and do Tools=Macro=Macros select SaveWorkbook and click run You should not select save or save as using the menus. You should use the macro to save the file by executing the macro, not saving from the menu. -- Regards, Tom Ogilvy "ole_" wrote in message ... It's not working, i put it in "thisworkbook" but it only saves your code, and mine code is still activated so if i say yes to save it erases my commandbuttons, heres how i put it in: Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub __________________________________________________ __________________________ __ Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Husk og brug 'Gem Som' når du gemmer denne fil", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub "Tom Ogilvy" skrev i en meddelelse ... You have to disable events before you do your save. Sub SaveWorkbook() Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True End Sub Use the above code to save your workbook after you put in the code. -- Regards, Tom Ogilvy "ole_" wrote in message ... Hi, I have a huge problem, i have 2 pricelist one national an one international both are exactly the same only the language is different, here comes my problem they are XLS files and due to other reasons they cant be XLT, i have some code that deletes my commandbuttons when they "save as" because i dont want that the commandbottuns one the file to the customer. And here comes my real problem i have managed to save the code below without deleting the commandbuttons in the national version but can't do it in the int. version and i really dont now how i did it?? :-( I also have a Enableevent when the national succeded but again how? Here it comes 'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Application.EnableEvents = False 'ActiveWorkbook.Save 'Application.EnableEvents = True 'End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then MsgBox "Remember to 'Save As' when you want to save this file", vbCritical Cancel = True End If '---------------------------------------------------------------- 'Sub RemoveShapes() '---------------------------------------------------------------- Dim shp As Shape Dim sTopLeft As String Dim fOK As Boolean Worksheets("4 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("6 Farver").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp Worksheets("8 Farver ").Activate For Each shp In ActiveSheet.Shapes fOK = True testStr = "" On Error Resume Next sTopLeft = shp.TopLeftCell.Address 'Autofilter and Data Validation dropdowns 'don't seem to have a topleftcell address. On Error GoTo 0 If shp.Type = msoFormControl Then If shp.FormControlType = xlDropDown Then If testStsTopLeftr = "" Then 'keep it fOK = False End If End If End If If fOK Then shp.Delete End If Next shp End Sub |
Problem with save some code
Dave Peterson and I had some fun with that code :-) Bob "ole_" wrote in message ... yes and no, i was trying to use "enableEvents = False" so that i have a chance ro save my code without deleting my commandbuttons, i think i used it in my national file when i created it. but i was trying so many things, an suddently it worked i was just jumoing up an down of joy and did not now how i did it. But your code works perfecly :-) Ole |
| All times are GMT +1. The time now is 05:38 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com