AW: Frage geändert = VBA Username abfrage als Passwort
04.05.2014 14:47:11
fcs
Hallo Mark,
hier ein Beispielcode für ein Userform mit einer Listbox in der die Daten zu dem angemeldeten Usernamen angezeigt werden sollen. Für die Gruppen-Chefs ist ein entsprechender Vergleich der Gruppen-Nummer als ODER Prüfung eingebaut.
Sinnvoller als die Anzeige in einer Listbox eines Userforms ist es meiner Meinung nach, wenn die Daten des angemeldeten Users aus dem Blatt mit allen Daten in ein separates Blatt übertragen werden.
Das könnte man beim Öffnen der Datei automatisch machen. Vor dem Schliessen der Datei werden die Daten in diesem Blatt automatisch wieder gelöscht.
Gruß
Franz
'Code im Userform
Option Explicit
Private wksData As Worksheet 'Tabellenblatt mit den im Userform anzuzeigenden Daten
Private lngSpaUser As Long 'Spalte mit dem Usernamen
Private lngSpaGruppe As Long 'Spalte mit den Nummern der Gruppen
Private strUser As String 'User-Name
Private intGruppe As Integer 'Gruppen-Nr für prüfung bei Gruppen-Chefs
Private arrData()
Private Sub CommandButton_Beenden_Click()
'Beenden-Schaltfläche des Userforms
Erase arrData
Set wksData = Nothing
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim Zeile As Long, Spalte As Long, Zeile_L As Long, Spalte_L As Long, lngI As Long
Set wksData = ActiveWorkbook.Worksheets("Umsatz") 'Tabellenblatt anzuzeigenden Daten
lngSpaUser = 2 'Spalte mit dem Usernamen
lngSpaGruppe = 3 'Spalte mit den Gruppennummern
strUser = VBA.Environ("Username")
'Prüfen, ob angemeldeter User Chef einer Gruppe ist
intGruppe = 0
'im Blatt "Auswahllisten" in Spalte F nach dem Usernamen suchen und aus _
Spalte E die Gruppennummer auslesen
'In Spalte E stehen ab Zeile 3 die Nummern der Gruppen und in Spalte die _
Usernamen der Gruppenchefs
With Worksheets("Auswahllisten")
Zeile_L = .Cells(.Rows.Count, 6).End(xlUp).Row
For Zeile = 3 To Zeile_L
If .Cells(Zeile, 6).Text = strUser Then
intGruppe = .Cells(Zeile, 5).Value
Exit For
End If
Next Zeile
End With
'Listbox-Einstellungen - diese können auch direkt im Formulareditor unter den _
Eigenschaften der Box gemacht werden
Spalte_L = 9 'letzte Daten-Spalte in Tabelle
With Me.ListBox1
.ColumnCount = Spalte_L
.ColumnWidths = "40Pt;50Pt;30Pt;50Pt;50Pt;30Pt;30Pt;30Pt;40Pt"
.BoundColumn = 1
End With
'Daten zu Username aus Datentabelle in Datenarray einlesen
Erase arrData
With wksData
lngI = 0
Zeile_L = .Cells(.Rows.Count, lngSpaUser).End(xlUp).Row
For Zeile = 2 To Zeile_L
If .Cells(Zeile, lngSpaUser).Text = strUser _
Or .Cells(Zeile, lngSpaGruppe).Value = intGruppe Then
lngI = lngI + 1
ReDim Preserve arrData(1 To Spalte_L, 1 To lngI)
For Spalte = 1 To Spalte_L
arrData(Spalte, lngI) = .Cells(Zeile, Spalte).Value
Next Spalte
End If
Next Zeile
End With
If lngI > 0 Then
'Daten aus Daten-Array in die Auswahlliste der Listbox übertragen
Me.ListBox1.Column = arrData
Else
MsgBox "Keine Daten zum Usernamen """ & strUser & """ gefunden."
End If
End Sub