合並兩個私人工作簿

Question

我有兩個帶有Private Workbook_open（）的vba宏。 我對VBA不太了解。

這是“此工作簿”的完整代碼：

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

而且我在上面的代碼的最后一個條目的模塊上有此選項，以嘗試防止文件的復制（我知道它很糟糕，但是目前我不需要更多。）

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

出於測試目的進行了評論。 它給了我重復的workbook_open條目。

我還有另一個Excel文件可以檢索序列號，並且應該允許或不允許使用基於該序列號的文件。 因為它給了我workbook_open重復項。

最好的祝福

Answer 1

您為什么不能像下面這樣合並它們？

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