SCOTTWHITTAKER2333
New Member
- Joined
- Jun 1, 2010
- Messages
- 32
I found the code while serching for a way to get users to enable the macros on a sheet the i have been working on. The problem that i am having is that is seems to be causing a proble with a different code that I have on a userform.
Here is the link to the code I found:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
Here is the actual code:
The code that it is causing a problem with is on a userform that pops up on open and runs a saveas. It creates a filename based on optins chosen from the userform.
Here is the code that seems to have stopped working:
Any Ideas on how to get these two to work together?
I think it has something to do with the custom save in the new code but I really have no idea were to go with this.
Here is the link to the code I found:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
Here is the actual code:
Code:
[COLOR=blue]Option Explicit[/COLOR]
[COLOR=blue]Const[/COLOR] WelcomePage = "Macros"
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_BeforeClose(Cancel [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR])
[COLOR=darkgreen]'Turn off events to prevent unwanted loops[/COLOR]
Application.EnableEvents = [COLOR=blue]False[/COLOR]
[COLOR=darkgreen]'Evaluate if workbook is saved and emulate default propmts[/COLOR]
[COLOR=blue]With[/COLOR] ThisWorkbook
[COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] .Saved [COLOR=blue]Then[/COLOR]
[COLOR=blue]Select Case[/COLOR] MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
[COLOR=blue]Case[/COLOR] [COLOR=blue]Is[/COLOR] = vbYes
[COLOR=darkgreen]'Call customized save routine[/COLOR]
[COLOR=blue]Call[/COLOR] CustomSave
[COLOR=blue]Case[/COLOR] [COLOR=blue]Is[/COLOR] = vbNo
[COLOR=darkgreen]'Do not save[/COLOR]
[COLOR=blue]Case[/COLOR] [COLOR=blue]Is[/COLOR] = vbCancel
[COLOR=darkgreen]'Set up procedure to cancel close[/COLOR]
Cancel = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Select[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=darkgreen]'If Cancel was clicked, turn events back on and cancel close,[/COLOR]
[COLOR=darkgreen]'otherwise close the workbook without saving further changes[/COLOR]
[COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] Cancel = [COLOR=blue]True[/COLOR] [COLOR=blue]Then[/COLOR]
.Saved = [COLOR=blue]True[/COLOR]
Application.EnableEvents = [COLOR=blue]True[/COLOR]
.Close savechanges:=[COLOR=blue]False[/COLOR]
[COLOR=blue]Else[/COLOR]
Application.EnableEvents = [COLOR=blue]True[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_BeforeSave([COLOR=blue]ByVal[/COLOR] SaveAsUI [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR], Cancel [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR])
[COLOR=darkgreen]'Turn off events to prevent unwanted loops[/COLOR]
Application.EnableEvents = [COLOR=blue]False[/COLOR]
[COLOR=darkgreen]'Call customized save routine and set workbook's saved property to true[/COLOR]
[COLOR=darkgreen]'(To cancel regular saving)[/COLOR]
[COLOR=blue]Call[/COLOR] CustomSave(SaveAsUI)
Cancel = [COLOR=blue]True[/COLOR]
[COLOR=darkgreen]'Turn events back on an set saved property to true[/COLOR]
Application.EnableEvents = [COLOR=blue]True[/COLOR]
ThisWorkbook.Saved = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_Open()
[COLOR=darkgreen]'Unhide all worksheets[/COLOR]
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]Call[/COLOR] ShowAllSheets
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] CustomSave(Optional SaveAs [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR])
[COLOR=blue]Dim[/COLOR] ws [COLOR=blue]As[/COLOR] Worksheet, aWs [COLOR=blue]As[/COLOR] Worksheet, newFname [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
[COLOR=darkgreen]'Turn off screen flashing[/COLOR]
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=darkgreen]'Record active worksheet[/COLOR]
[COLOR=blue]Set[/COLOR] aWs = ActiveSheet
[COLOR=darkgreen]'Hide all sheets[/COLOR]
[COLOR=blue]Call[/COLOR] HideAllSheets
[COLOR=darkgreen]'Save workbook directly or prompt for saveas filename[/COLOR]
[COLOR=blue]If[/COLOR] SaveAs = [COLOR=blue]True[/COLOR] [COLOR=blue]Then[/COLOR]
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
[COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] newFname = "False" [COLOR=blue]Then[/COLOR] ThisWorkbook.SaveAs newFname
[COLOR=blue]Else[/COLOR]
ThisWorkbook.Save
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=darkgreen]'Restore file to where user was[/COLOR]
[COLOR=blue]Call[/COLOR] ShowAllSheets
aWs.Activate
[COLOR=darkgreen]'Restore screen updates[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] HideAllSheets()
[COLOR=darkgreen]'Hide all worksheets except the macro welcome page[/COLOR]
[COLOR=blue]Dim[/COLOR] ws [COLOR=blue]As[/COLOR] Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
[COLOR=blue]For Each[/COLOR] ws [COLOR=blue]In[/COLOR] ThisWorkbook.Worksheets
[COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] ws.Name = WelcomePage [COLOR=blue]Then[/COLOR] ws.Visible = xlSheetVeryHidden
[COLOR=blue]Next[/COLOR] ws
Worksheets(WelcomePage).Activate
[COLOR=blue]End Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] ShowAllSheets()
[COLOR=darkgreen]'Show all worksheets except the macro welcome page[/COLOR]
[COLOR=blue]Dim[/COLOR] ws [COLOR=blue]As[/COLOR] Worksheet
[COLOR=blue]For Each[/COLOR] ws [COLOR=blue]In[/COLOR] ThisWorkbook.Worksheets
[COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] ws.Name = WelcomePage [COLOR=blue]Then[/COLOR] ws.Visible = xlSheetVisible
[COLOR=blue]Next[/COLOR] ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
[COLOR=blue]End Sub[/COLOR]
</PRE>
Here is the code that seems to have stopped working:
Code:
Private Sub CommandButton1_Click()
Dim MyNames$, fName$
GiveMeAName:
dat = Me.date10.Value
shift = Me.shif.Value
MyNames = Format(dat, "mm-dd-yy") & "-" & "components" & shift & ".xls"
fName = ThisWorkbook.Path & "\" & MyNames
If Dir(fName, vbDirectory) <> "" Then
MsgBox "A file named '" & MyNames & " already exists." & vbCr & vbCr & _
MyNames & " will now open."
Workbooks.Open fName
ThisWorkbook.Close False
Exit Sub
End If
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & MyNames, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Worksheets("WEST LANE B").Range("AN4") = Me.date10.Value
Worksheets("EAST LANE A").Range("AN4") = Me.date10.Value
start.Hide
End Sub
I think it has something to do with the custom save in the new code but I really have no idea were to go with this.
Last edited: