合并两个私人工作簿

Question

I have two vba macros with Private Workbook_open(). I dont know much about VBA.

Here is the full code on "this workbook":

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fname As Variant
    On Error GoTo ErrorHandler
    If SaveAsUI Then
        Cancel = True   'Cancel the original SaveAs
         'Get filename (with path) for saving
        fname = Application.GetSaveAsFilename(fileFilter:="Excel Marcro-Enabled Workbook (*.xlsm),*.xlsm")
        If fname = False Then Exit Sub  'Exit if user hit Cancel
        Application.EnableEvents = False  'Prevent this event from firing
        ThisWorkbook.SaveAs Filename:=fname, FileFormat:=52
          '52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010)
        Application.EnableEvents = True  'Re-enable events
    End If
Exit Sub
ErrorHandler:
    Application.EnableEvents = True   'So events are never left disabled.
    MsgBox "An error occured during save." & Err.Number, vbCritical, "Error"
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Step 1:  Declare your variables
    Dim ws As Worksheet
'Step 2: Unhide the Starting Sheet
    sheets("START").Visible = xlSheetVisible
'Step 3: Start looping through all worksheets
    For Each ws In ThisWorkbook.Worksheets
 'Step 4: Check each worksheet name
    If ws.Name <> "START" Then
 'Step 5: Hide the sheet
    ws.Visible = xlVeryHidden
    End If
   'Step 6:  Loop to next worksheet
    Next ws
'Step 7:  Save the workbook
    ActiveWorkbook.Save
End Sub

Private Sub workbook_open()
'Step 1:  Declare your variables
    Dim ws As Worksheet
'Step 2: Start looping through all worksheets
    For Each ws In ThisWorkbook.Worksheets
 'Step 3: Unhide All Worksheets
    ws.Visible = xlSheetVisible
'Step 5:  Loop to next worksheet
    Next ws
'Step 6:  Hide the Start Sheet
    sheets("START").Visible = xlVeryHidden
    sheets("FJaneiro").Visible = xlVeryHidden
    sheets("FFevereiro").Visible = xlVeryHidden
    sheets("FMarco").Visible = xlVeryHidden
    sheets("FAbril").Visible = xlVeryHidden
    sheets("FMaio").Visible = xlVeryHidden
    sheets("FJunho").Visible = xlVeryHidden
    sheets("FJulho").Visible = xlVeryHidden
    sheets("FAgosto").Visible = xlVeryHidden
    sheets("FSetembro").Visible = xlVeryHidden
    sheets("FOutubro").Visible = xlVeryHidden
    sheets("FNovembro").Visible = xlVeryHidden
    sheets("FDezembro").Visible = xlVeryHidden
    sheets("ferias").Visible = xlVeryHidden
    sheets("Instruções").Visible = xlVeryHidden
    sheets("Feriados").Visible = xlVeryHidden
    sheets("CalculadoraRecibo").Visible = xlVeryHidden
    sheets("ReciboCartaoRef").Visible = xlVeryHidden
    sheets("ReciboJuntoRef").Visible = xlVeryHidden
    sheets("CalculadoraManual").Visible = xlVeryHidden
    Application.WindowState = xlMaximized
End Sub

Private Sub workbook_open()
     'This code is to Test PC serilNo
    Dim oFSO As Object
    Dim drive As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set drive = oFSO.GetDrive("C:\")

     '*This line to check Drive SerialNumber
    If drive.SerialNumber <> <-THE SERIAL NUMBER HERE-> Then Application.Run "KillThefit"

     '*release memory
    Set oFSO = Nothing
    Set drive = Nothing
End Sub

And I have this on a module for the last entry on the code above to try to prevent the copy of the file ( I know it's poor but I dont need more at this time.)

Sub KillThefit()
     '*This code is to prevent illegal copying
MsgBox "Cópia não autorizada. ", vbExclamation + vbMsgBoxRight

    Application.DisplayAlerts = False
    'ThisWorkbook.ChangeFileAccess xlReadOnly
    'Kill ThisWorkbook.FullName
    'ThisWorkbook.Close False
    Application.DisplayAlerts = False

End Sub

It's commented for testing purposes. It gives me duplicate workbook_open entry.

I have another excel file to retrieve the serial number and it's supposed to allow or not the use of the file based on that serial number. As it is it gives me the workbook_open duplicate entry.

Best regards

Answer 1

Is there a reason you can't combine them like the below?

Private Sub workbook_open()
'Step 1:  Declare your variables
    Dim ws As Worksheet
'Step 2: Start looping through all worksheets
    For Each ws In ThisWorkbook.Worksheets
 'Step 3: Unhide All Worksheets
    ws.Visible = xlSheetVisible
'Step 5:  Loop to next worksheet
    Next ws
'Step 6:  Hide the Start Sheet
    sheets("START").Visible = xlVeryHidden
    sheets("FJaneiro").Visible = xlVeryHidden
    sheets("FFevereiro").Visible = xlVeryHidden
    sheets("FMarco").Visible = xlVeryHidden
    sheets("FAbril").Visible = xlVeryHidden
    sheets("FMaio").Visible = xlVeryHidden
    sheets("FJunho").Visible = xlVeryHidden
    sheets("FJulho").Visible = xlVeryHidden
    sheets("FAgosto").Visible = xlVeryHidden
    sheets("FSetembro").Visible = xlVeryHidden
    sheets("FOutubro").Visible = xlVeryHidden
    sheets("FNovembro").Visible = xlVeryHidden
    sheets("FDezembro").Visible = xlVeryHidden
    sheets("ferias").Visible = xlVeryHidden
    sheets("Instruções").Visible = xlVeryHidden
    sheets("Feriados").Visible = xlVeryHidden
    sheets("CalculadoraRecibo").Visible = xlVeryHidden
    sheets("ReciboCartaoRef").Visible = xlVeryHidden
    sheets("ReciboJuntoRef").Visible = xlVeryHidden
    sheets("CalculadoraManual").Visible = xlVeryHidden
    Application.WindowState = xlMaximized

    'This code is to Test PC serilNo
    Dim oFSO As Object
    Dim drive As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set drive = oFSO.GetDrive("C:\")

     '*This line to check Drive SerialNumber
    If drive.SerialNumber <> <-THE SERIAL NUMBER HERE-> Then Application.Run "KillThefit"

     '*release memory
    Set oFSO = Nothing
    Set drive = Nothing
End Sub