Problem with userform vba when new macro added.

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:
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>
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:
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
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.
 
Last edited:

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Never mind. I desided that i did not need a macro that was this advanced.
I just ended up going with a simpler one that simply hid all but the error sheet on close with a auto save on closing.
I then put vba code in to hide the error sheet and show the regular sheets on open.
Like This in the workbook open:
Code:
Worksheets("sheetname1").Visible = True
Worksheets("errorsheet").Visible = False
And like this in the workbook close:
Code:
Worksheets("errorsheet").Visible = True
Worksheets("sheetname").Visible = False
ThisWorkbook.Save
Not nearly as fancy as the one i was trying but with the people that will be using my forms I don't really have to worry about them cheating.
 
Upvote 0

Forum statistics

Threads
1,224,899
Messages
6,181,627
Members
453,058
Latest member
rmd0725

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top