合并两个私人工作簿

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