0

ここにあるいくつかのコードを採用しましたhttp://www.vbaexpress.com/kb/getarticle.php?kb_id=379ユーザーにマクロを有効にすることを強制するきちんとしたソリューションです。この方法は、この問題を回避するための非常に優れた方法です。ただし、私の追加要件は次のとおりです。ある特定のユーザーが、ワークブック内の 2 つのシートのより機密性の高いバージョンを必要としています。MsgBox への回答に応じて、InputBox はパスワードの検証を要求し、これらのシートの機密バージョンを表示します。答えは、ワークブックを保存する方法と、ワークブックを再度開いたときにすべてのシートを再表示する方法にあると思います (2 つのシートは実質的にパスワードでロックされているため) が、どういうわけか、このワークブックを開くと、2 つを再表示するために使用されるパスワードワークブックを開くには、シートの機密バージョンが必要です。そのため、上記のシートの検証に必要なパスワードを変更しましたが、ワークブックを開くには元のパスワードが引き続き必要です。

Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False

     'Evaluate if workbook is saved and emulate default propmts
    With ThisWorkbook
        If Not .Saved Then
            Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
                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
            End Select
        End If

         'If Cancel was clicked, turn events back on and cancel close,
         'otherwise close the workbook without saving further changes
        If Not Cancel = True Then
            .Saved = True
            Application.EnableEvents = True
            .Close savechanges:=False
        Else
            Application.EnableEvents = True
        End If
    End With
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

Private Sub Workbook_Open()
     'Unhide all worksheets


    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True

        Dim msg1, msg2, Pwd As String

    Pwd = "5555"

    Do

    msg1 = MsgBox("Are you the Master User?", vbYesNo)

    Loop Until msg1 = vbNo Or msg1 = vbYes

    If msg1 = vbNo Then
    Worksheets("Sensitive Sheet 1").Visible = xlVeryHidden
    Worksheets("Sensitive Sheet 2").Visible = xlVeryHidden

    ThisWorkbook.Unprotect Password:=Pwd
    ElseIf msg1 = vbYes Then

    Do
    msg2 = InputBox("Please Enter the Password", "Password Checker", vbOKOnly)
    Loop Until msg2 = Pwd

    Worksheets("Sensitive Sheet 1").Visible = True
    Worksheets("Sensitive Sheet 2").Visible = True
    Worksheets("Standard Sheet 1").Visible = xlVeryHidden
    Worksheets("Standard Sheet 2").Visible = xlVeryHidden

    End If





End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
    Dim WS As Worksheet, aWs As Worksheet, newFname As String
     'Turn off screen flashing
    Application.ScreenUpdating = False

     'Record active worksheet
    Set aWs = ActiveSheet

     'Hide all sheets
    Call HideAllSheets

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

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

     'Restore screen updates
    Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
     'Hide all worksheets except the macro welcome page
    Dim WS As Worksheet

    Worksheets(WelcomePage).Visible = xlSheetVisible

    For Each WS In ThisWorkbook.Worksheets
        If Not WS.Name = WelcomePage Then WS.Visible = xlSheetVeryHidden
    Next WS

    Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
     'Show all worksheets except the macro welcome page

    Dim WS As Worksheet


    For Each WS In ThisWorkbook.Worksheets

        If WS.Name <> "Sensitive Sheet 1" And WS.Name <> "Sensitive Sheet 2" Then

            If Not WS.Name = WelcomePage Then WS.Visible = xlSheetVisible

        End If

    Next WS

    Worksheets(WelcomePage).Visible = xlSheetVeryHidden

End Sub
4

1 に答える 1