vbscript 欢迎页面没有宏

Posted 2021-05-21

'Copy this to ThisWorkbook module

Option Explicit

'==================================================================================================================================================
'   WORKBOOK EVENTS
'==================================================================================================================================================

Private Sub Workbook_Open()

    Application.ScreenUpdating = False
    
    Call ShowWelcome
    
    Application.ScreenUpdating = True
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Sh              As Worksheet
Dim ProtectStatus   As Boolean
Static msgResult    As Variant


'   Turn off events to prevent unwanted loops
    Application.EnableEvents = False

    Set Sh = GetWorksheetFromCodeName(Me, SHT_WELCOMEPAGE)	'Define CodeName as CONST
    ProtectStatus = Sh.ProtectContents

	If ProtectStatus = False And IsEmpty(msgResult) Then
		msgResult = MsgBox("A lapvédelem ki van kapcsolva. Biztos kilép?", vbYesNo, "Figyelmeztetés")
		If msgResult = vbNo Then
			Cancel = True
			GoTo CheckCancel
		End If
	End If

'   Evaluate if workbook is saved and emulate default propmts
    If Not ThisWorkbook.Saved Then    
        Select Case MsgBox("Kívánja menteni a '" & ThisWorkbook.Name & "' változtatásait?", _
                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
                GoTo CheckCancel
        End Select            
    End If

CheckCancel:
'   If Cancel was clicked, turn events back on and cancel close,
'	otherwise close the workbook without saving further changes
    With ThisWorkbook
        If Not Cancel = True Then
            Application.EnableEvents = True
            .Saved = True
            If Not Workbooks.Count > 1 Then Application.Quit
        Else
            Application.EnableEvents = True
        End If
    End With
    msgResult = Empty
    
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


'==================================================================================================================================================
'   METHODS
'==================================================================================================================================================

Private Sub CustomSave(Optional SaveAs As Boolean)

Dim ws 			As Worksheet
Dim aWs 		As Worksheet
Dim newFname 	As String

'	Turn off screen flashing
    Application.ScreenUpdating = False

'	Record active worksheet
    Set aWs = ActiveSheet

'	Show WelcomeNoMacro
    Call ShowWelcomeNoMacro

'	Save workbook directly or prompt for saveas filename
    If SaveAs = True Then
        newFname = Application.GetSaveAsFilename( _
        fileFilter:="Macro Enabled Excel Files, *.xlsm; *.xlsb")
        If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
    Else
        ThisWorkbook.Save
    End If

'	Restore file to where user was
    Call ShowWelcome
    aWs.Activate

'	Restore screen updates
    Application.ScreenUpdating = True

End Sub

Private Sub ShowWelcomeNoMacro()

Dim Sh              As Worksheet
Dim ShNoMacro       As Worksheet
Dim ProtectStatus   As Boolean

    Set Sh = GetWorksheetFromCodeName(Me, SHT_WELCOMEPAGE)				'Define CodeName as CONST
    Set ShNoMacro = GetWorksheetFromCodeName(Me, SHT_WELCOMEPAGENOMACRO)'Define CodeName as CONST
    
'   Turn protection off otherwise hide/unhide won't work
    ProtectStatus = GetProtectStatus
    Call ProtectionOFF(ProtectStatus, ThisWorkbook)
    
    ShNoMacro.Visible = xlSheetVisible
    Sh.Visible = xlSheetVeryHidden
        
    ShNoMacro.Activate
    
'   Restore protection
    Call ProtectionON(ProtectStatus, ThisWorkbook)

End Sub

Private Sub ShowWelcome()

Dim Sh 				As Worksheet
Dim ShNoMacro 		As Worksheet
Dim ProtectStatus   As Boolean

    Set Sh = GetWorksheetFromCodeName(Me, SHT_WELCOMEPAGE)				 'Define CodeName as CONST
    Set ShNoMacro = GetWorksheetFromCodeName(Me, SHT_WELCOMEPAGENOMACRO) 'Define CodeName as CONST
    
'   Turn protection off otherwise hide/unhide won't work
    ProtectStatus = GetProtectStatus
    Call ProtectionOFF(ProtectStatus, ThisWorkbook)
    
    ShNoMacro.Visible = xlSheetVeryHidden
    Sh.Visible = xlSheetVisible
    Sh.Activate
    
'   Restore protection
    Call ProtectionON(ProtectStatus, ThisWorkbook)
       
End Sub