Åbn/Lås rækker afhængig af bruger

Udfordring: To forskellige personer bruger regnearket. Bruger A (i koden kaldet Per) må kun taste i rækkerne 2, 4 og 8. Bruger B (i koden kaldet Veronica) må kun taste i rækkerne 1, 3, 5 til 7 og 9 til 200. De øvrige rækker i arket, må der ikke taste i, og brugere - bortset fra disse to, må ikke kunne taste. Det hele skal klares ved hhv at åbne og låse de relevante rækker.

Í koden bedes man om at intaste sit navn, når regnearket åbnes, men faktisk kunne det hentes fra det Windows-login, den enkelte er logget på med, eller det navn, vedkommende er registreret under i Excel. I førstnævnte tilfælde skal linjen

Bruger = UCase(InputBox("Indtast brugernavn"))

erstattes med

Bruger = UCase(Environ$("UserName"))

som henter information fra Windows. I andet tilfælde skal den erstattes med

Bruger = UCase(Application.UserName)

som henter informationen fra Excel. I begge tilfælde skal Case Is linjerne ændres til det, som er relevant. Fx kunne per være logget på Windows med PFR som brugernavn, og så skal den første Case Is rettes til

Case Is = "PFR"

hvis der bruges Windows login. Bruges der i steder brugernavnet fra Excel og Per her er oprette som Per Frandsen, skal lin jen i stedet hedde

Case Is = "Per FRANDSEN"

Men med en inputbox til at taste brugernavnet i, ser koden således ud.

Private Sub Workbook_Open()
    Dim Bruger As String
    Dim LCol As Integer
    Dim LRow As Long


    Bruger = UCase(InputBox("Indtast brugernavn"))

    Select Case Bruger
        Case Is = "PER"
            With ActiveSheet
                .Unprotect
                .Range("1:1, 3:3, 5:7, 9:200").Locked = True
                .Range("2:2, 4:4, 8:8").Locked = False
                .Protect Contents:=True
                .EnableSelection = xlUnlockedCells
        End With
    Case Is = "VERONICA"
        With ActiveSheet
            .Unprotect
            .Range("2:2, 4:4, 8:8").Locked = True
            .Range("1:1, 3:3, 5:7, 9:200").Locked = False
            .Protect Contents:=True
            .EnableSelection = xlUnlockedCells
        End With
    Case Else
        ActiveSheet.Unprotect
        ActiveSheet.Cells.Locked = True
        ActiveSheet.Protect
    End Select

End Sub

Koden kan formodentlig optimeres, men da den løser opgaven, har jeg ikke brugt tid på det.