Låse et faneblad

Højreklik på det sheet, du vil have låst og vælg 'vis kode' og indsæt denne kode.


Private Password_memory As String
Private Sub worksheet_activate()
    Dim Password As String
   
    'Insert password here:
    Password = "Password"
   
    If UCase(Password_memory) = UCase(Password) Then
        Exit Sub
    End If
   
    With ActiveSheet
        .Visible = False
        .Visible = True
        Password_memory = InputBox("Input password", "Password")
        If UCase(Password_memory) = UCase(Password) Then
            .Activate
        Else
            MsgBox ("Incorrect password - You are not allowed to view this sheet")
        End If
    End With
End Sub

Hvis passworded skal slettes hver gang man deaktiverer sheetet, skal dette også indsættes:

Private Sub worksheet_deactivate()
    Password_memory = Empty
End Sub

/1.

hej
har lige prøvet, men når man åbner selve regnearket kan man se, hvad der står i fanebladet. Det er først når man forsøger, at skifte mellem fanebladene, at det virker. Det skal helst virke når man åbner regnearket

det virker fint hos mig - meget anvendelig funktionalitet iøvrigt!

Argh.. det kan omgås hvis makroer fravælges :(..

Dette skjuler arket mens der gemmes. Arket bliver vist igen efter det er blevet gemt og når man åbner dokumentet.. dvs. arket vil være skjult hvis makroer fravælges.

For at ligge koden ind:
1. Alt + F11
2. Ctrl + R (viser project explorer hvis den ikke allerede er synlig)
3. I Project explorer under 'Microsoft Excel Objects' dobbeltklik på 'ThisWokrbook' og sæt denne kode ind:

Private Sub workbook_open()
    show_hidden_sheets
End Sub
Private Sub workbook_beforesave(ByVal SaveAsUI As Boolean, ByRef Cancel As Boolean)
    hide_hidden_sheets
    Application.OnTime Now, "show_hidden_sheets"
End Sub

4. Insert -> Module -> Indsæt denne kode (Du skal ændre Sheet3 til det låste arks navn):

Function show_hidden_sheets()
    Sheets("Sheet3").Visible = True
End Function
Function hide_hidden_sheets()
    Sheets("Sheet3").Visible = xlVeryHidden
End Function

Jeg skal måske lige nævne at man med bare lidt teknisk forståelse kan bryde igennem. For at gøre det sværere:
5. Tools -> VBAProject Properties -> Protection -> opret passwordbeskyttelse.

Vh Mathias.

Jeg prøver lige at formulere spørgsmålet lidt bedre. Jeg har en række sælgere, der har et fortrolig budget. Dvs de må ikke se hinandens budgetter. Jeg vil gerne rundsende et samlet regneark med et faneblad for hver sælger med budgettal og opnået salg. Når sælgerne åbner dette regneark må han dog kun kunne se hans eget faneblad. Derfor vil jeg gerne kunne låse alle faneblade med en kode pr. sælger. Håber dette giver mening.

sij>> den addition jeg lige har posted løser også din tidligere problemstilling.

/1.

Ok.. jeg vender tilbage om ca. 15 min med en løsning..

super

I et modul (#4 i min forklaring).

Option Explicit
Private sheet_arr As Variant, password_arr As Variant
Function show_sheet(ByVal password As String) As Boolean
    define_passwords
    Dim t As Integer
    For t = 0 To UBound(password_arr)
        If UCase(password) = UCase(password_arr(t)) Then
            Sheets(sheet_arr(t)).Visible = True
            show_sheet = True
        End If
    Next
End Function
Function hide_sheets()
    define_passwords
    Dim t As Integer
    For t = 0 To UBound(sheet_arr)
        Sheets(sheet_arr(t)).Visible = xlVeryHidden
    Next
End Function
Function define_passwords()
    sheet_arr = Array(1, 2, 3, 4, 5)
    password_arr = Array(1, 2, 3, 4, 5)
End Function

I ThisWorkbook (#3)

Option Explicit
Private Sub workbook_open()
    Do Until show_sheet(InputBox("Input password", "Password"))
        MsgBox ("Incorrect password")
    Loop
End Sub
Private Sub workbook_beforesave(ByVal SaveAsUI As Boolean, ByRef Cancel As Boolean)
    hide_sheets
End Sub



Du skal ændre disse variabler såleder at de kommer på denne form:
sheet_arr = Array("Sælger 1 sheet name","Sælger 2 sheet name")
password_arr = Array("Sælger 1 password","Sælger 2 password")

En bruger kan også have flere sheets hvis password er det samme for begge sheets - og der kan også være flere der har adgang til samme sheet:
sheet_arr = Array("Sheet 1","Sheet 2")
password_arr = Array("password 1","password 1")


Du kan i hvert fald prøve dig frem og spørge hvis du skal have hjælp til noget..

Tusind tak for hjælpen.

hvis du sender et nyt svar kan jeg give dig point

Velbekommen.. jeg har fået point og behøver ikke flere, hvis det var det du mente?!

/1..

lige et spørgsmål til. Når jeg har skrevet passwordet til et faneblad, og derefter ønsker adgang til et andet, hvordan gør jeg så det? Og kan jeg det?
Vil gerne give flere point for svar

Så skulle scriptet være modificeret..

Opret en button: vis -> værktøjslinjer -> formularer og tegn en button.

Denne skal linke til makroen show_sheet (du skal selv skrive show_sheet). Jeg skal ikke have flere points.

I Modul:

Option Explicit
Private sheet_arr As Variant, password_arr As Variant
Function show_sheet()
    hide_sheets
    Dim t As Integer, password As String, sheet_showed As Boolean
    Do While True
        password = InputBox("Input password", "Password")
        If password = "" Then
            Exit Do
        End If
        sheet_showed = False
        For t = 0 To UBound(password_arr)
            If UCase(password) = UCase(password_arr(t)) Then
                Sheets(sheet_arr(t)).Visible = True
                sheet_showed = True
            End If
        Next
        If sheet_showed Then
            Exit Do
        End If
        MsgBox ("Incorrect password")
    Loop
End Function
Function hide_sheets()
    define_passwords
    Dim t As Integer
    For t = 0 To UBound(sheet_arr)
        Sheets(sheet_arr(t)).Visible = xlVeryHidden
    Next
End Function
Function define_passwords()
    sheet_arr = Array("ark1", "ark2")
    password_arr = Array("1", "2")
End Function

ThisWorkbook:

Option Explicit
Private Sub workbook_open()
    show_sheet
End Sub
Private Sub workbook_beforesave(ByVal SaveAsUI As Boolean, ByRef Cancel As Boolean)
    hide_sheets
End Sub

/1

Det er perfekt. Tusind tak for hjælpen.