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
|