none
How to protect excel IF user not enable macro RRS feed

  • Question

  • I want to lock all cel if they not enable macro or can't save or cannot select cell or some solution for help me

    now i used  this code  for lock Excel cell after value is entered

    1.Unlock all cel

    2.Protect sheet with the same password in code

    3.Put the code in workbook

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ActiveSheet.Unprotect "password"
    Target.Locked = True
    ActiveSheet.Protect "password", AllowInsertingRows:=True
    End Sub

    but the code not work IF user not eanble  MACRO



    Monday, October 13, 2014 9:08 AM

All replies

  • Macros has to be enabled in order for any code to execute in your application. 

    The most known method for making sure that a user enables macros is to create a wrapper worksheet, aka. splash screen asking the user to enable macros to be able to use the workbook while hiding all other worksheets etc.


    Monday, October 13, 2014 9:31 AM
  • On user's machine, you can add path of the file in trusted location to enable macro automatically (All macro enabled files opened from that location will enable macro by default).

    File-->Options-->Trust Center-->Trust Center Settings-->Add New Location. (Excel 2010)

     

    Monday, October 13, 2014 9:31 AM
  • Macros has to be enabled in order for any code to execute in your application. 

    The most known method for making sure that a user enables macros is to create a wrapper worksheet, aka. splash screen asking the user to enable macros to be able to use the workbook while hiding all other worksheets etc.


     thank you verry much  i saw the code from here  it work

    http://xl-central.com/force-users-to-enable-macros-in-a-workbook.html

    and put my code to end of this code

    'Force the explicit declaration of variables
    Option Explicit
    
    'Assign the name of the warning sheet to a constant
    Const Warning As String = "Warning"
    
    Private Sub Workbook_Open()
    
        'Turn off screen updating
        Application.ScreenUpdating = False
        
        'Call the ShowAllSheets routine
        Call ShowAllSheets
        
        'Set the workbook's Saved property to True
        Me.Saved = True
        
        'Turn on screen updating
        Application.ScreenUpdating = True
        
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
        'Declare the variable
        Dim Ans As Integer
        
        'If the workbook's Saved property is False, emulate Excel's default save prompt
        If Me.Saved = False Then
            Do
                Ans = MsgBox("Do you want to save the changes you made to '" & _
                    Me.Name & "'?", vbQuestion + vbYesNoCancel)
                Select Case Ans
                    Case vbYes
                        Call CustomSave
                    Case vbNo
                        Me.Saved = True
                    Case vbCancel
                        Cancel = True
                        Exit Sub
                End Select
            Loop Until Me.Saved
        End If
        
    End Sub
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
        'Cancel regular saving
        Cancel = True
        
        'Call the CustomSave routine
        Call CustomSave(SaveAsUI)
        
    End Sub
    
    Private Sub CustomSave(Optional SaveAs As Boolean)
    
        'Declare the variables
        Dim ActiveSht As Object
        Dim FileFormat As Variant
        Dim FileName As String
        Dim FileFilter As String
        Dim FilterIndex As Integer
        Dim Msg As String
        Dim Ans As Integer
        Dim OrigSaved As Boolean
        Dim WorkbookSaved As Boolean
        
        'Turn off screen updating
        Application.ScreenUpdating = False
        
        'Turn off events so that the BeforeSave event doesn't occur
        Application.EnableEvents = False
        
        'Assign the status of the workbook's Saved property to a variable
        OrigSaved = Me.Saved
        
        'Assign the active sheet to an object variable
        Set ActiveSht = ActiveSheet
        
        'Call the HideAllSheets routine
        Call HideAllSheets
        
        'Save workbook or prompt for SaveAs filename
        If SaveAs Or Len(Me.Path) = 0 Then
            If Val(Application.Version) < 12 Then
                FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls"
                FilterIndex = 1
            Else
                FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
                    "Excel 97-2003 Workbook (*.xls), *.xls"
                If Right(Me.Name, 4) = ".xls" Then
                    FilterIndex = 2
                Else
                    FilterIndex = 1
                End If
            End If
            Do
                FileName = Application.GetSaveAsFilename( _
                    InitialFileName:=Me.Name, _
                    FileFilter:=FileFilter, _
                    FilterIndex:=FilterIndex, _
                    Title:="SaveAs")
                If FileName = "False" Then Exit Do
                If IsLegalFilename(FileName) = False Then
                    Msg = "The file name is invalid.  Try one of the "
                    Msg = Msg & "following:" & vbCrLf & vbCrLf
                    Msg = Msg & Chr(149) & " Make sure that the file name "
                    Msg = Msg & "does not contain any" & vbCrLf
                    Msg = Msg & "   of the following characters:  "
                    Msg = Msg & "< > ? [ ] : | or *" & vbCrLf
                    Msg = Msg & Chr(149) & " Make sure that the file/path "
                    Msg = Msg & "name does not exceed" & vbCrLf
                    Msg = Msg & "   more than 218 characters."
                    MsgBox Msg, vbExclamation, "Invalid File Name"
                Else
                    If Val(Application.Version) < 12 Then
                        FileFormat = -4143
                    Else
                        If Right(FileName, 4) = ".xls" Then
                            FileFormat = 56
                        Else
                            FileFormat = 52
                        End If
                    End If
                    If Len(Dir(FileName)) = 0 Then
                        Application.DisplayAlerts = False
                        Me.SaveAs FileName, FileFormat
                        Application.DisplayAlerts = True
                        WorkbookSaved = True
                    Else
                        Ans = MsgBox("'" & FileName & "' already exists.  " & _
                            "Do you want to replace it?", vbQuestion + vbYesNo, _
                            "Confirm Save As")
                        If Ans = vbYes Then
                            Application.DisplayAlerts = False
                            Me.SaveAs FileName, FileFormat
                            Application.DisplayAlerts = True
                            WorkbookSaved = True
                        End If
                    End If
                End If
            Loop Until Me.Saved
        Else
            Application.DisplayAlerts = False
            Me.Save
            Application.DisplayAlerts = True
            WorkbookSaved = True
        End If
        
        'Call the ShowAllSheets routine
        Call ShowAllSheets
        
        'Activate the prior active sheet
        ActiveSht.Activate
        
        'Set the workbook's Saved property
        If WorkbookSaved Then
            Me.Saved = True
        Else
            Me.Saved = OrigSaved
        End If
        
        'Turn on screen updating
        Application.ScreenUpdating = True
        
        'Turn on events
        Application.EnableEvents = True
        
    End Sub
    
    Private Sub HideAllSheets()
    
        'Declare the variable
        Dim Sh As Object
        
        'Display the warning sheet
        Sheets(Warning).Visible = xlSheetVisible
        
        'Hide every sheet, except the warning sheet
        For Each Sh In Sheets
            If Sh.Name <> Warning Then
                Sh.Visible = xlSheetVeryHidden
            End If
        Next Sh
        
    End Sub
    
    Private Sub ShowAllSheets()
    
        'Declare the variable
        Dim Sh As Object
        
        'Display every sheet, except the warning sheet
        For Each Sh In Sheets
            If Sh.Name <> Warning Then
                Sh.Visible = xlSheetVisible
            End If
        Next Sh
        
        'Hide the warning sheet
        Sheets(Warning).Visible = xlSheetVeryHidden
        
    End Sub
    
    Private Function IsLegalFilename(ByVal fname As String) As Boolean
        Dim BadChars As Variant
        Dim i As Long
        If Len(fname) > 218 Then
            IsLegalFilename = False
            Exit Function
        Else
            BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
            fname = GetFileName(fname)
            For i = LBound(BadChars) To UBound(BadChars)
                If InStr(1, fname, BadChars(i)) > 0 Then
                    IsLegalFilename = False
                    Exit Function
                End If
            Next i
        End If
        IsLegalFilename = True
    End Function
    
    Private Function GetFileName(ByVal FullName As String) As String
        Dim i As Long
        For i = Len(FullName) To 1 Step -1
            If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
        Next i
        GetFileName = Mid(FullName, i + 1)
    End Function



    Monday, October 13, 2014 10:32 AM
  • On user's machine, you can add path of the file in trusted location to enable macro automatically (All macro enabled files opened from that location will enable macro by default).

    File-->Options-->Trust Center-->Trust Center Settings-->Add New Location. (Excel 2010)

     

    thank you
    Monday, October 13, 2014 10:32 AM