Skjul arkfane for brugere

Denne Sub skjuler alle ark - med undtagelse af det aktuelle medarbejdernavn
Hvis det kan være en hjælp:

Private Sub skjulArk(MedarbejderNavn)
    For ark = 1 To ActiveWorkbook.Sheets.Count
        If LCase(ActiveWorkbook.Sheets(ark).Name) <> MedarbejderNavn Then
            ActiveWorkbook.Sheets(ark).Visible = False
        End If
    Next ark
End Sub

Hvorfra får jeg medarbejdernavn ???

Medarbejderens login er ikke det samme som arkfanenavnet

Jeg forestillede mig, at du havde et ark med medarbejdernavnene - UserId hvorfra du kunne finde den pågældende medarbejder via Username..

Det har jeg også :-)

Jeg kunne bare ikke lige gennemskue f din kode, hvor Environ("username") kom ind i billedet.

Dim userID
Private Sub workbook_open()
    userID = Application.UserName
   
    usernavn = findUserNavn(userID)
    If usernavn <> "" Then
        skjulArk usernavn
    Else
        ActiveWorkbook.Close
    End If
End Sub
Private Function findUserNavn(uID)
    ActiveWorkbook.Sheets("UserId").Visible = True
   
    ActiveWorkbook.Sheets("UserID").Activate
    With ActiveSheet
        For ræk = 2 To 65000
            If .Cells(1, 1) = "" Then
                Exit For
            End If
           
            If LCase(.Cells(ræk, 1)) = LCase(userID) Then
                findUserNavn = .Cells(ræk, 2)
                Exit Function
            End If
        Next ræk
    End With
    findUserNavn = ""
   
End Function
Private Sub skjulArk(MedarbejderNavn)
Dim fundet As Boolean
    For ark = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(ark).Visible = True
    Next ark
   
    fundet = False
   
    For ark = 1 To ActiveWorkbook.Sheets.Count
        If LCase(ActiveWorkbook.Sheets(ark).Name) <> LCase(MedarbejderNavn) Then
            ActiveWorkbook.Sheets(ark).Visible = False
        Else
            ActiveWorkbook.Sheets(ark).Visible = True
            fundet = True
        End If
    Next ark
   
    If fundet = False Then
        ActiveWorkbook.Close
    End If
End Sub

Supertekst > super som vanligt ... men ...

... jeg har også behov for at een af brugerne i UserID har superbrugeradgang til alle arkfaner. Dette angives i kolonne 3 ( rolle ) ... er kan man være identificeret som User eller Supervisor ... Supervisor har ret til at se/arbejde med alle ark

Dim userID
Private Sub workbook_open()
Dim rolle
    userID = Application.UserName
   
    usernavn = findUserNavn(userID, rolle)
    If usernavn <> "" Then
        If LCase(rolle) <> "supervisor" Then
            skjulArk usernavn
        Else
            visAlleArk
        End If
    Else
        ActiveWorkbook.Close
    End If
End Sub
Private Function findUserNavn(uID, rolle)
    ActiveWorkbook.Sheets("UserId").Visible = True
   
    ActiveWorkbook.Sheets("UserID").Activate
    With ActiveSheet
        For ræk = 2 To 65000
            If .Cells(1, 1) = "" Then
                Exit For
            End If
           
            If LCase(.Cells(ræk, 1)) = LCase(userID) Then
                findUserNavn = .Cells(ræk, 2)
                rolle = .Cells(ræk, 3)
                Exit Function
            End If
        Next ræk
    End With
    findUserNavn = ""
   
End Function
Private Sub skjulArk(MedarbejderNavn)
Dim fundet As Boolean
    For ark = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(ark).Visible = True
    Next ark
   
    fundet = False
   
    For ark = 1 To ActiveWorkbook.Sheets.Count
        If LCase(ActiveWorkbook.Sheets(ark).Name) <> LCase(MedarbejderNavn) Then
            ActiveWorkbook.Sheets(ark).Visible = False
        Else
            ActiveWorkbook.Sheets(ark).Visible = True
            fundet = True
        End If
    Next ark
   
    If fundet = False Then
        ActiveWorkbook.Close
    End If
End Sub
Private Sub visAlleArk()
    For ark = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(ark).Visible = True
    Next ark
End Sub

Smukt ... det virker

Tillæg :

Hvis denne virker til at vise alle arkfaner :

Private Sub visAlleArk()
    For ark = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(ark).Visible = True
    Next ark

End Sub

Hvorfor virker denne så ikke ????

Private Sub SkjulAlleArk()
    For ark = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(ark).Visible = False
    Next ark

End Sub

Fordi der altid skal være mindst et ark synligt...

dumt spørgsmål - men hvis åbner og deaktivere Makroer.. kan man vel se fanen med ark > vis ???

bør de skjulte ark ikke som standard være veryhidden ? (og gemme alle ark -1 som very hidden når filen lukkes)...

komputerdk > absolut relevant spørgsmål ...

Regnearket / modellen jeg arbejder med, er en flex-tids skabelon, som skal benyttes afdelingsvis, dvs. flere medarbejdere i eet og samme regneark (i hver sin arkfane).

Er der nogen smart måde hvormed man kan opnå denne "veryhidden" funktionalitet ... og er der kan man i det hele taget forhindre brugere i at deaktivere makro ved åbning af regnearket ????

Lås VBA-projektet via password

Nu har jeg efterhånden fået det til at virke :-)

ActiveWorkbook.Unprotect / ActiveWorkbook.Protect .... kan man ikke tilknytte password i vba koden ???

Eks.:

Private Sub Beskyttelse(bMode)
    If bMode = False Then
        ActiveWorkbook.Sheets(Ark).Unprotect Password:="PassWord"
    Else
        ActiveWorkbook.Sheets(Ark).Protect Password:="PassWord"
    End If
End Sub

Ok ... takker

Det blev lidt snørklet ... men det virker :-)

Så kan vi vel afslutte denne runde?

Ja .... tak for dit input :-)