I need help to integrate two codes

mikeydo

New Member
Joined
Nov 12, 2010
Messages
39
Hi Everyone

I have 2 codes that I need to integrate. I have tried and I get a compiler error saying ambiguous name detected: Workbook Before_Close on the following line

Code:
[COLOR=#0000ff]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_BeforeClose(Cancel [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR])

There is another event with this line of code and I understand that this event can only be used once. Can anyone help to intergrate these codes.

Thanks
Mike
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

mikeydo

New Member
Joined
Nov 12, 2010
Messages
39
Hi Jeffrey, your right sorry heres the 2 codes I want to integrate in Thisworkbook

1st code

Code:
[Option Explicit
 
 ' http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
Const WelcomePage = "Macros"
Private Sub Workbook_Open()
    bQuit
     'Unhide all worksheets
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False
    
     'Evaluate if workbook is saved and emulate default propmts
    With ThisWorkbook
        If Not .Saved Then
            Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
                vbYesNoCancel + vbExclamation)
            Case Is = vbYes
                 'Call customized save routine
                Call CustomSave
            Case Is = vbNo
                 'Do not save
            Case Is = vbCancel
                 'Set up procedure to cancel close
                Cancel = True
            End Select
        End If
        
         'If Cancel was clicked, turn events back on and cancel close,
         'otherwise close the workbook without saving further changes
        If Not Cancel = True Then
            .Saved = True
            Application.EnableEvents = True
            .Close savechanges:=False
        Else
            Application.EnableEvents = True
        End If
    End With
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False
    
     'Call customized save routine and set workbook's saved property to true
     '(To cancel regular saving)
    Call CustomSave(SaveAsUI)
    Cancel = True
    
     'Turn events back on an set saved property to true
    Application.EnableEvents = True
    ThisWorkbook.Saved = True
End Sub
 
 
Private Sub CustomSave(Optional SaveAs As Boolean)
    Dim ws As Worksheet, aWs As Worksheet, newFname As String
     'Turn off screen flashing
    Application.ScreenUpdating = False
    
     'Record active worksheet
    Set aWs = ActiveSheet
    
     'Hide all sheets
    Call HideAllSheets
    
     'Save workbook directly or prompt for saveas filename
    If SaveAs = True Then
        newFname = Application.GetSaveAsFilename( _
        fileFilter:="Excel Files (*.xls), *.xls")
        If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
    Else
        ThisWorkbook.Save
    End If
    
     'Restore file to where user was
    Call ShowAllSheets
    aWs.Activate
    
     'Restore screen updates
    Application.ScreenUpdating = True
End Sub
 
Private Sub HideAllSheets()
     'Hide all worksheets except the macro welcome page
    Dim ws As Worksheet
    
    Worksheets(WelcomePage).Visible = xlSheetVisible
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws
    
    Worksheets(WelcomePage).Activate
End Sub
 
Private Sub ShowAllSheets()
     'Show all worksheets except the macro welcome page
    
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws
    
    Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
 
 ' http://www.vbaexpress.com/forum/showthread.php?p=271128
Private Sub bQuit()
    Dim User As String, passWord As String
    User = "MIKE-PC;" 'separate with ";"
    If CBool(InStr(1, User, Environ("computername") & ";")) Then
         'workbbok is enabled show its content
    Else
         'passWord = InputBox("Password for Manual Access:", vbCritical, "Automatic Access Denied -  Last Chance")
         'If passWord <> "ken" Then ThisWorkbook.Close
        MsgBox "ACCESS DENIED - This Software has 1 Licence only. To Upgrade to a Multiple Licence please contact us at mike.duffy1@sky.com", vbCritical, "Access Denied"
        ThisWorkbook.Close
    End If
End Sub
 
 
 
Private Sub bQuit2()
    Dim User As String, passWord As String
    User = "MIKE-PC;" 'separate with ";"
    If CBool(InStr(1, User, Environ("computername") & ";")) Then
         'workbbok is enabled show its content
    Else
        passWord = InputBox("Password for Manual Access:", vbCritical, "Automatic Access Denied -  Last Chance")
        If passWord <> "MIKE-PC;" Then ThisWorkbook.Close
    End If
End Sub
/CODE]




and heres the 2nd code I want to integrate into Thisworkbook

[CODE][Option Explicit
 
Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow)    ' cut
    Call EnableMenuItem(19, Allow)    ' copy
    Call EnableMenuItem(22, Allow)    ' paste
    Call EnableMenuItem(755, Allow)   ' pastespecial
 
'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow
 
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
            Case Is = False
                .OnKey "^c", "CutCopyPasteDisabled"
                .OnKey "^v", "CutCopyPasteDisabled"
                .OnKey "^x", "CutCopyPasteDisabled"
                .OnKey "+{DEL}", "CutCopyPasteDisabled"
                .OnKey "^{INSERT}", "CutCopyPasteDisabled"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            End Select
    End With
End Sub
 
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
     'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub
 
Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
    MsgBox "Sorry!  Cutting, copying and pasting have been disabled in this workbook!"
End Sub
/CODE]


and heres the code I want in Module1

[Code]Option Explicit
 
Private Sub Workbook_Activate()
    Call ToggleCutCopyAndPaste(False)
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ToggleCutCopyAndPaste(True)
End Sub
 
Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
End Sub
 
Private Sub Workbook_Open()
    Call ToggleCutCopyAndPaste(False)
End Sub


Thanks

Mike
 

Watch MrExcel Video

Forum statistics

Threads
1,122,182
Messages
5,594,727
Members
413,927
Latest member
PolAmer

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
Top