Skrivebeskytte evt. med kode

Ideer:

Kan kunne via en makro styrer de frie og begrænsede celler - således at de begrænsede celler skal defineres - f.eks. række 4 - og i det tilfælde at en celle heri aktiveres - bedes der om adgangskode via en lille userform.

Eller der placeres en fil (C:\) hos den/de bruger der har specielle adgangsrettigheder.
Heri kunne adgangen defineres.

Eller brugernavnet kan aflæses via deres login og dermed rettigheder.
Sidstnævnte skaldog afprøves inden.

Du kan fint aflæse deres login-id via et lille api-kald.
Så lader du blot makroen skjule/vise de nødvendige rækker (selvfølgelig skal der låses op, skjules/vises og låses igen)

Der skal ikke noget specielt stort nummer til for at lave det.

Her lidt vedr. brugerID'et

Private Declare Function GetUserName Lib "advapi32" _
    Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) As Long

Public Function SmartOffice_UserId() As String
    ' Return the windows UserID
    Dim sRetVal As String

    sRetVal = String(100, Chr$(0))
    GetUserName sRetVal, 100
    SmartOffice_UserId = Trim$(Left$(sRetVal, InStr(sRetVal, Chr$(0)) - 1))

End Function

Public Sub Test()
    MsgBox SmartOffice_UserId
End Sub

og lidt mere til skjulning med password på arket - god fornøjelse

Public Sub SmartRights()
    Const sSheetPassword As String = "glemdet"
    Dim wksTemp As Worksheet
    Set wksTemp = workssheets("Sheet1")
   
    Select Case UCase(SmartOffice_UserId)
        Case "FV" 'se række 3
            wksTemp.Unprotect Password:=sSheetPassword
            wksTemp.Range("A2:A5").EntireRow.Hidden = True
            wksTemp.Range("A3").EntireRow.Hidden = False
            wksTemp.Protect Password:=sSheetPassword
        Case "HLK" 'se række 4
            wksTemp.Unprotect Password:=sSheetPassword
            wksTemp.Range("A2:A5").EntireRow.Hidden = True
            wksTemp.Range("A4").EntireRow.Hidden = False
            wksTemp.Protect Password:=sSheetPassword
        Case "PPP" 'developer
            wksTemp.Unprotect Password:=sSheetPassword
            wksTemp.Range("A2:A5").EntireRow.Hidden = False
        Case Else 'må ikke se
            wksTemp.Unprotect Password:=sSheetPassword
            wksTemp.Range("A2:A5").EntireRow.Hidden = True
            wksTemp.Protect Password:=sSheetPassword
    End Select
    ' CleanUp
    Set wksTemp = Nothing
End Sub

Hvilken xl-version bruger du?

Styring af disse rettighed er jo allerede indbygget i xl2003