结合两个私人workbook_open

时间:2018-06-15 20:28:34

标签: excel-vba vba excel

我有两个带有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重复条目。

祝你好运

1 个答案:

答案 0 :(得分:0)

你有没有理由将它们组合起来,如下所示?

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