VBA: Bedingte Passwortfunktion
#1
Hallo Zusammen,

im angehängten Beispiel sind zwei Userforms verknüpft.
Die zweite Userform ist durch die Eingabe eines Passworts zu erreichen, das in diesem Fall „Test“ lautet. 

1)
Nun hätte ich es aber gerne, dass das Passwort variiert in Abhängigkeit der zuvor ausgewählten Dropdown-Auswahl.
Also z.B.:
Auswahl „Einrichtung Sommer“ à PW: Test
                „Einrichtung Meer“ à PW: Test1
usw.
Wie wäre das umzusetzen?

2)
In Abhängigkeit von der im ersten Schritt getätigten Auswahl soll das Listenfeld in der nächsten Userform nur die Infos aufnehmen, die der Auswahl entsprechen.
Also: 

Wurde in Schritt 1) „Einrichtung Sommer“ gewählt und durch eigenes Passwort bestätigt, soll in  TextBox2 der zweiten Userform unveränderbar „Sommer“ stehen und das Listenfeld mit den korrespondierenden Daten aus der Tabelle füllen.
Derzeit geschieht das noch über eine Suchfunktion in TextBox2. Das soll weg.

  Oh je, ich bin doch noch so ahnungslos…Vielen Dank für Eure Ratschläge und schönen Gruß!


Angehängte Dateien
.xlsm   Test.xlsm (Größe: 46,35 KB / Downloads: 8)
Top
#2
Hallo,

zuallererst mal der obligatorische Hinweis: Passwortschütze dieser Art (und leider jeglicher Art in Excel) sind in Wahrheit keinerlei Schutz, sie gaukeln einen solchen nur vor. Also sei darauf hingewiesen, dass dieser "Schutz" von mittelbegabten Excelanwendern in Kombination mit Suchmaschinen binnen 5 Minuten ausgehebelt ist.

Für 1)
Code:
Private Sub cmd_OK_Click()
Dim intz As Integer
Dim PW As String

Select Case ComboBox1.Value
   Case "Sommer"
       PW = "Test"
   Case "Meer"
       PW = "Test1"
End Select

If TXT_Passwort.Value <> PW Then
   intz = intz + 1
   If intz = 1 Then
       MsgBox "Falsches Passwort!"
   Else
       TXT_Passwort.Value = ""
       TXT_Passwort.SetFocus
   End If
Else
   MsgBox "Sie haben das Passwort richtig eingegeben!" & vbLf & _
   "Der Zugang wird gewährt!", vbInformation
   
   UserForm2.Hide
   UserForm1.Show
End If

End Sub

Die MsgBox "Sie haben das Passwort richtig eingegeben" sieht nett aus, bietet allerdings überhaupt keinen Mehrwert. Sie ist einzig ein zusätzlich notwendiger Klick für den User. Das kannst du natürlich halten wie du magst, aber ich wäre spätestens nach der dritten Anmeldung genervt davon.
Schöne Grüße
Berni
Top
#3
Nachtrag zu 1)
Beachte, dass du in deinem Text von Einrichtung "Sommer" schreibst, in der Beispielmappe steht aber "Sonne". Also nicht wundern, wenn es nicht hinhaut!


Zu 2)
a) Schreib in ein allgemeines Modul (zB Modul1) ganz oben hin
Code:
Public Einrichtung As String

b) Korrektur des oben genannten Codes für das Passwortformular
Code:
Private Sub cmd_OK_Click()
Dim intz As Integer
Dim PW As String

Select Case ComboBox1.Text
   Case "Sonne"
       PW = "Test"
   Case "Meer"
       PW = "Test1"
End Select

If TXT_Passwort.Value <> PW Then
   intz = intz + 1
   If intz = 1 Then
       MsgBox "Falsches Passwort!"
   Else
       TXT_Passwort.Value = ""
       TXT_Passwort.SetFocus
   End If
Else
   Einrichtung = ComboBox1.Text
   MsgBox "Sie haben das Passwort richtig eingegeben!" & vbLf & _
   "Der Zugang wird gewährt!", vbInformation
   
   UserForm2.Hide
   UserForm1.Show
End If

End Sub

c) Der Code für dein UserForm2 lautet
Code:
Private Sub UserForm_Initialize()

Dim i As Integer, Zeile As Integer
Dim wks As Worksheet

Set wks = Sheets("tbl_MA")

With wks

'Überschrift der UserForm aus Zelle A1 holen
Me.Caption = .Range("A1").Value

For i = 1 To 10
  Me.Controls("Label" & i).Caption = .Cells(2, i).Value
Next i

'Überschrift der ListBox aus Tabelle holen
For i = 1 To 5
Me.Controls("Label" & i + 10).Caption = .Cells(2, i).Value
Next i
End With

'ListBox einstellen

With ListBox1
   .ColumnCount = 6                              'Spaltenanzahl festlegen
   .ColumnWidths = "102;102;102;102;102;10"      'Spaltenbreiten definieren
   For Zeile = 3 To Sheets("tbl_MA").Cells(Rows.Count, 1).End(xlUp).Row
       If wks.Cells(Zeile, 2) = Einrichtung Then
           .AddItem
           .List(.ListCount - 1, 0) = wks.Cells(Zeile, 1)
           .List(.ListCount - 1, 1) = wks.Cells(Zeile, 2)
           .List(.ListCount - 1, 2) = wks.Cells(Zeile, 3)
           .List(.ListCount - 1, 3) = wks.Cells(Zeile, 4)
           .List(.ListCount - 1, 4) = wks.Cells(Zeile, 5)
           .List(.ListCount - 1, 5) = wks.Cells(Zeile, 6)
       End If
   Next Zeile
End With

'Cursor standardmäßig in die erste TextBox setzen



With Me.TextBox2
.SetFocus
.Font.Size = 12
.Font.Bold = True
.Font.Italic = True
End With


End Sub

Bitte Code so komplett übernehmen, da auch neue Variablen eingesetzt wurden.
Schöne Grüße
Berni
Top
#4
Hallo Berni,

Zitat:5 Minuten ausgehebelt ist.


das ist aber sehr großzügig angesetzt.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Top
#5
Drum meinte ich ja, das gilt für mittelbegabte Exceluser :D
Schöne Grüße
Berni
Top
#6
Vielen Dank! Mit dem PW funktioniert wunderbar und ist für die User absolut ausreichend.

Leider bewirkt der zweite Code nicht den gewünschten Effekt - es ist genauso wie vorher. Was mache ich falsch? Alles gemacht wie von Dir beschrieben.
Top
#7
Hast du bei den Eigenschaften des Listenfelds die Spaltenzahl (ColumnCount) auf 6 gestellt?
Schöne Grüße
Berni
Top
#8
Anbei noch die Beispielmappe inkl. Code.


Angehängte Dateien
.xlsm   Beispiel.xlsm (Größe: 41,81 KB / Downloads: 11)
Schöne Grüße
Berni
Top
#9
MisterBurns, ich fummel hier rum wie der größte Dilettant u krieg's nicht hin...

Bzgl. deines Bspl.:

Wähle ich eine Einrichtung in UF1 aus, enthält die Listbox in UF2 zwar direkt die entsprechenden Datensätze - aber: ich kann in TextBox "Einrichtung" dann immer noch Daten anderer Einrichtungen generieren lassen, was ja eben durch die PW-Eingabe unterbunden werden sollte.

Desweiteren u abgesehen davon: wenn ich dann einen Datensatz i.d. Listbox anklick, werden die TB 1-10 nicht mehr mit den Daten gefüllt.
Es heißt dann "Laufzeitfehler 13: typen unverträglich"

 --> lngZeile = Me.ListBox1.Column(5, Me.ListBox1.ListIndex) - hier stimme was nicht.

Ahhhhh :20: :22:
Top
#10
Hola,

zur Info...

http://www.herber.de/forum/messages/1684769.html
https://www.ms-office-forum.net/forum/sh...p?t=359353

Gruß,
steve1da
[-] Folgende(r) 1 Nutzer sagt Danke an steve1da für diesen Beitrag:
  • Storax
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 2 Gast/Gäste