Hi Dave, Thanks for your help. I'm new to macro, let me gothru the
link...---Thanks...Shafeek
| I don't know how to use windows authentication, but maybe you could use
the
| user's network name and check that.
|
| If you want to try.
|
| This code goes behind a General Module:
|
| Option Explicit
| Public mySheetNamesToProtect As Variant
| Const myPWD As String = "PWD"
|
| Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
| "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
| Function fOSUserName() As String
| ' Returns the network login name
| Dim lngLen As Long, lngX As Long
| Dim strUserName As String
| strUserName = String$(254, 0)
| lngLen = 255
| lngX = apiGetUserName(strUserName, lngLen)
| If lngX <> 0 Then
| fOSUserName = Left$(strUserName, lngLen - 1)
| Else
| fOSUserName = ""
| End If
| End Function
| Sub InitializeSheets()
| mySheetNamesToProtect = Array("sheet1", "sheet3", "sheet5", "sheet6")
| End Sub
| Sub UnprotectSheets()
| Dim iCtr As Long
|
| If UserNameOk = False Then
| Exit Sub
| Else
| If IsArray(mySheetNamesToProtect) = False Then
| Call InitializeSheets
| End If
|
| For iCtr = LBound(mySheetNamesToProtect) _
| To UBound(mySheetNamesToProtect)
| Worksheets(mySheetNamesToProtect(iCtr)).Unprotect
Password:=myPWD
| Next iCtr
| End If
|
| End Sub
| Sub ProtectSheets()
| Dim iCtr As Long
|
| If IsArray(mySheetNamesToProtect) = False Then
| Call InitializeSheets
| End If
|
| For iCtr = LBound(mySheetNamesToProtect) To
UBound(mySheetNamesToProtect)
| Worksheets(mySheetNamesToProtect(iCtr)).Protect Password:=myPWD
| Next iCtr
| End Sub
| Function UserNameOk() As Boolean
|
| Select Case LCase(fOSUserName)
| Case Is = "harry smith", "joe smith", "dick smith"
| UserNameOk = True
| Case Else
| UserNameOk = False
| End Select
|
| End Function
|
| =============
| This code goes behind the ThisWorkbook module:
|
| Option Explicit
| Dim mySheetNamesToProtect As Variant
| Private Sub Workbook_BeforeClose(Cancel As Boolean)
|
| Dim resp As Long
|
| If Me.Saved Then Exit Sub 'nothing to do, so don't do anything
|
| resp = MsgBox("Do you want to save your changes?", vbYesNoCancel,
"Close")
|
| Select Case resp
| Case vbYes
| Call Workbook_BeforeSave(False, False)
| Case vbNo
| Me.Saved = True
| Case vbCancel
| Cancel = True
| End Select
| End Sub
| Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
|
| Dim anErrorOccurred As Boolean
|
| Cancel = True
|
| If SaveAsUI = True Then
| MsgBox "File|SaveAs not allowed!"
| Exit Sub
| End If
|
| Call ProtectSheets
|
| anErrorOccurred = False
| On Error Resume Next
| Application.EnableEvents = False
| Me.Save
| If Err.Number <> 0 Then
| MsgBox "something went wrong--file not saved!"
| anErrorOccurred = True
| Err.Clear
| End If
| Application.EnableEvents = True
| On Error GoTo 0
|
| Call UnprotectSheets
|
| If anErrorOccurred = False Then
| Me.Saved = True
| End If
|
| End Sub
| Private Sub Workbook_Open()
| Call UnprotectSheets
| End Sub
|
| =========
| You'll want to change at least 3 things:
|
| mySheetNamesToProtect = Array("sheet1", "sheet3", "sheet5", "sheet6")
| is the list of sheets to protect/unprotect.
|
| Const myPWD As String = "PWD"
| gives the common password for each of those sheets.
|
| and
| Case Is = "harry smith", "joe smith", "dick smith"
| is the list of authorized users
|
| If you're new to macros, you may want to read David McRitchie's intro at:
|
http://www.mvps.org/dmcritchie/excel/getstarted.htm
|
|
| "Shafeek.Khalidh" wrote:
| >
| > Hi All,
| >
| > I've like to protect an excel work book. It has lots of sheets and I
edit it
| > every day. Here, I've to enter a password to unprotect and enter the
| > password twice to protect it for each sheet.
| >
| > Is there any method in which I can use windows authentication in excel,
so
| > if a specified user can edit the excel with out giving any password.
Excel
| > validate the user with his user id which is stored in the excel.
| >
| > Thanks.....Shafeek
|
| --
|
| Dave Peterson
