< návrat zpět

MS Excel


Téma: Zabezpečení listu pomocí VBA rss

Zaslal/a 14.2.2012 12:06

Dobrý den,

řeším nový projekt a potřeboval bych zaheslovat některé listy v sešitě aby k nim měl přístup pouze určitý uživatel s platným heslem. Zároveň musí data zůstat skrytá než bude heslo zadáno. Našel jsem VBA kód, který by můj problém mohl vyřešit, ale nejsem schopný ho se svými omezenými znalostmi VBA upravit do funkční podoby. Největší problém je s tím, že se list zobrazí i po zadání nesprávného hesla. Mohl by mi prosím někdo poradit co dělám špatně?

Potřeboval bych zaheslovat a zebezpečit List1 pojmenovaný "Effectifs" heslem např. Heslo123 s počtem pokusů 3. Kód je:

Dim correct_pass_given As Integer
Dim hide_sheet As Worksheet

Private Sub Workbook_Open()
correct_pass_given = Heslo123
'Set hide_sheet = List1 '
List2.Select
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Dim strPass As String
Dim lCount, number_of_tries_allowed As Long
Set hide_sheet = List1 '
number_of_tries_allowed = 3 '
'MsgBox correct_pass_given

If ActiveSheet.Name <> "Effectifs" Or correct_pass_given = 1 Then
Else
hide_sheet.Columns.Hidden = True
'Allow 3 attempts at password
For lCount = 1 To number_of_tries_allowed
strPass = InputBox(Prompt:="Password Please", Title:="PASSWORD REQUIRED")
If strPass = vbNullString Then 'Cancelled
MsgBox "Password incorrect", vbCritical, "Message"
Else: correct_pass_given = 1 'Correct Password
Exit For
End If
Next lCount
If lCount = number_of_tries_allowed + 1 Then '
Exit Sub
Else 'Allow viewing
hide_sheet.Columns.Hidden = False
End If
End If
End Sub

stop Uzamčeno - nelze přidávat nové příspěvky.

#007293
Stalker
Něco pro inspiraci
Příloha: rar7293_05_03_controlskeycode.rar (25kB, staženo 35x)
citovat
#007294
avatar
skus


Dim correct_pass_given As Integer
Dim hide_sheet As Worksheet

Private Sub Workbook_Open()
heslo = Heslo123
Set hide_sheet = List1 '
List2.Select
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
heslo = "Heslo123"
Dim strPass As String
Dim lCount, number_of_tries_allowed As Long
Set hide_sheet = List1 '
number_of_tries_allowed = 3 '
'MsgBox correct_pass_given

If ActiveSheet.Name <> "List1" Or correct_pass_given = 1 Then
Else
hide_sheet.Columns.Hidden = True
'Allow 3 attempts at password
For lCount = 1 To number_of_tries_allowed
strPass = InputBox(Prompt:="Password Please", Title:="PASSWORD REQUIRED")
If strPass = vbNullString Or strPass <> heslo Then 'Cancelled
MsgBox "Password incorrect", vbCritical, "Message"
Else: correct_pass_given = 1 'Correct Password
Exit For
End If
Next lCount
If lCount = number_of_tries_allowed + 1 Then '
Exit Sub
Else 'Allow viewing
hide_sheet.Columns.Hidden = False
End If
End If
End Sub
citovat
#007295
avatar
Sub Makro1()
Set ws = Sheets("Effectifs")
For i = 1 To 3
heslo = InputBox("Heslo")
If heslo = "Heslo123" Then
ws.Visible = 1 - ws.Visible
Exit Sub
End If
Next i
Application.DisplayAlerts = False
Application.Quit
End Sub
citovat
#007304
avatar
misocko+marjankaj: To je boží, už to funguje, díky moc!!!

Stalker: Děkuju moc za inspiraci, to je hodně dobře udělaný, snad se s tím někdy takhle dobře naučím :-)citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Hromadné přepsání

elninoslov • 24.5. 10:29

Hromadné přepsání

Nomi • 24.5. 8:32

Index - každý rok začít od 1 Power Query

Alfan • 23.5. 9:17

nepřímý odkaz

elninoslov • 23.5. 0:00

nepřímý odkaz

bordov • 22.5. 18:35

vrácené hodnoty

Anonym • 22.5. 15:46

vrácené hodnoty

Anonym • 22.5. 15:45