Beskyttelse af regneark med adgangskode

Hvis de har et brugernavn på netværket og de logger ind, når de skal bruge mappen, kan du bruge det til at styre med.

Denne kode her, kræver at arkene har de samme navne, som brugerne på netværket.

Koden skal være i ThisWorkbook modulet

Private Sub Workbook_Open()
    Dim wshNetwork, Bruger As String, WS As Worksheet
    ActiveWindow.SelectedSheets.Visible = False
    Set wshNetwork = CreateObject("WScript.Network")
    Bruger = wshNetwork.UserName
    'Domæne = wshNetwork.userdomain
    'Computernavn = wshNetwork.ComputerName
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = Bruger Then
            Worksheets(Bruger).Visible = True
        Else
            WS.Visible = False
        End If
    Next
End Sub

Desværre arbejder de på en fælles computer, og har ikke selvstændig log in

Ja, så er det jo sværere, men du kan kun gøre det, hvis du kender deres password og de kan ikke ændre det, for det skal jo stå et sted i Excel mappen, hvad det er.

Man kan skjule kolonnerne i arket og dernæst beskytte arket. Skal nok laves i VBA, men jeg har ikke en færdig løsning.

Skjul kolonner:
Sheets("Ark1").Range("A:IV").EntireColumn.Hidden = True

Beskyt ark1 med kode abc:
Sheets("Ark1").Protect password:="abc", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=true

Det er desværre ikke kolonner der skal skjules.
Min plan var at der i en projektmappe var x antal ark (heraf var 4 skjulte og helt låst da de indeholder metadata)
De resterende ark var 1 personligt for hver medarbejder hvor de kunne føre deres tid ind i. Jeg ville så gerne beskytte de ark så man kun kunne se ens eget og også kun fik lov til at registre tid i ens eget ark, og ikke i de andres.
Håbede der var en mulighed for at man åbnede mappen med et logon som så kunne give adgang til at se 1 ark ( ens egen)

Jeg prøver at forklare:

1. lav alle arknavne om til det navn de skal logge ind med
2. skriv et dummy password f.eks("ABC123"),i en celle f.eks celle("IV1"),på hvert ark, det som hører til personen.
3. Forklar personen at han kan skifte password, ned at ændre i celle("IV1")
Så koden sådan

Private Sub Workbook_Open()
    Dim wshNetwork, Bruger As String, WS As Worksheet, Pass As String
    Bruger = InputBox("Indtast brugernavn", "Bruger")
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = Bruger Then
            Pass = InputBox("Indtast Password", "Bruger")
            If Worksheets(WS.Name).Range("IV1") <> Pass Then
                MsgBox ("Password er forkert")
                ThisWorkbook.Close False
                Application.Quit
            End If
            Worksheets(Bruger).Visible = True
        Else
            If WS.Name <> "Menu" Then
                WS.Visible = False
            End If
        End If
    Next
End Sub

Glemte lige at forklare at,

If WS.Name <> "Menu" Then

er lavet fordi, der mindst skal være et ark synlig, det har jeg her kaldt "Menu"

Jeg er helt novice, men vil gerne prøve. Du bliver desværre nok nødt til at forklare helt fra bunden hvordan jeg for koden ind.
K2 er den bedste placering af password og jeg har påført hver ark en kode.
Hvordan kommer jeg så videre.

Private Sub Workbook_Open()
    Dim wshNetwork, Bruger As String, WS As Worksheet, Pass As String
    Bruger = InputBox("Indtast brugernavn", "Bruger")
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = Bruger Then
            Pass = InputBox("Indtast Password", "Bruger")
            If Worksheets(WS.Name).Range("K2") <> Pass Then
                MsgBox ("Password er forkert")
                ThisWorkbook.Close False
                Application.Quit
            End If
            Worksheets(Bruger).Visible = True
        Else
            If WS.Name <> "Menu" Then
                WS.Visible = False
            End If
        End If
    Next
End Sub

Tryk ALT +F11, så kommer du til VBA editoren
dobbelt klik i vinduet til venstre på ThisWorkbbok,
Sæt så min kode ind i det hvide felt til højre

Husk at lave et ark, Der hedder "Menu", så vi kan beholde 1 synlig
Og husk at arkenes navne, skal være Brugernes brugernavne

Jeg har nu prøvet " god vejledning" Ros, men tror jeg har et problem.
Med brugerens brugernavne mener du så AD logon?? Det er nemlig en fælles computer.

I det øjeblik jeg laver en fanblad der hedder menu, og sætter din kode ind, for jeg godtnok et logonbilled frem når jeg vil åbne mappen, men da jeg jo ikke er en af brugerene kan jeg kun få adgang til menuarket.
Ville prøve at teste om jeg kunne logge ind med en af brugerene og det password jeg havde givet dem, men det får jeg ikke lov til.

med brugernavne, mener jeg et navn i aftaler, eller deres fornavn, det er ligemeget.
Får du både  inputboks til Brugernavn og derefter til Password, hvis du ikke får den til password, finder den ikke et ark der passer med brugernavnet.

Jeg har rettet koden, så du får at vide hvis brugeren ikke findes.

Private Sub Workbook_Open()
    Dim wshNetwork, Bruger As String, WS As Worksheet, Pass As String, Fundet As Boolean
    Fundet = False
    Bruger = InputBox("Indtast brugernavn", "Bruger")
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = Bruger Then
            Pass = InputBox("Indtast Password", "Bruger")
            If Worksheets(WS.Name).Range("K2") <> Pass Then
                MsgBox ("Password er forkert")
                ThisWorkbook.Close False
                Application.Quit
            End If
            Worksheets(Bruger).Visible = True
            Fundet = True
        Else
            If WS.Name <> "Menu" Then
                WS.Visible = False
            End If
        End If
    Next
    If Not Fundet Then
        MsgBox ("Bruger arket er ikke fundet")
        ThisWorkbook.Close False
        Application.Quit
    End If

End Sub

Det virker.
Mit eneste problem nu er at jeg har 5 ark i mappen der indeholder metadata, hvor der hentes oplysninger til de enkelte brugerark. Men i det øjeblik koden er indsat, har jeg ikke længere mulighed for at se disse ark.

Kan jeg på nogen måde ophæve koden så mappen igen bliver åben??? Har prøvet at slette koden igen, men det virker ikke rigtigt.
I alt fald smid et svar du har bestemt fortjent dine point. Jeg bliver nok nødt til en dag at prøve at lære noget mere om VBA

Når du har mappen åben, kan du altid, fra menulinjen vælge, Formater > Ark > vis,
da selve arket ikke er beskyttet, men kun skjult.

et svar ;-))