Něco pro inspiraci
Příloha: 
7293_05_03_controlskeycode.rar (25kB, staženo 36x)
citovat7293_05_03_controlskeycode.rar (25kB, staženo 36x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Zabezpečení listu pomocí VBA
Uzamčeno - nelze přidávat nové příspěvky.
MS Excel
Téma: Zabezpečení listu pomocí VBA 
Zaslal/a Prospero 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
Uzamčeno - nelze přidávat nové příspěvky.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
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
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 Subcitovat
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 Subcitovat
(15.2.2012 11:35)#007304
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
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)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články