VBA Dynamische Dropdowns

[Daniel555]

Hallo liebe Gemeinde 

ich bin echt am verzweifeln


Vorab möchte ich schon mal eins sagen, meine VBA Kenntnisse sind sehr mager, ich habe da sehr viel mit ChatGPT gearbeitet. Hat auch eigentlich immer gut funktioniert, aber jetzt hänge ich seit Tagen an ein und dem selben Problem.

Ich Umschreibe mal:

Die Tabelle die ich mir gebaut habe, ist ein Leistungsnachweis, die Mitarbeiter wählt seinen Namen aus und seine Unterschrift erscheint als Bild im Leistungsnachweis. Soweit so gut, nun ist es aber Datenschutzrechtlich eine Katastrophe wenn jeder von jedem den Namen und die Unterschrift sehen kann. Ich möchte aber unbedingt das es nur eine Tabelle / Leistungsnachweis gibt. Sonst müsste ich bei einer Änderung oder Anpassung ja x Tabellen anpassen.

Daher habe ich mir mit Hilfe von ChatGPT zwei VBA Codes erstellt. ( stelle ich weiter unten rein )

Dein Name ist nicht hinterlegt in der Tabelle ? Dropdown P5 bleibt leer

Dein Name ist hinterlegt in der Tabelle aber mit Admin : Nein    Dropdown enthält nur deinen Namen

Dein Name ist hinterlegt in der Tabelle und mit Admin : Ja        Dropdown enthält alle Namen 

dann hatte ich das Problem wenn ich als Admin die Tabelle in einen OneDrive Ordner eines Kollegen verschoben hatte, das er trotzdem alle Namen sehen konnte obwohl keine Admin. Aber da ich als Admin als letzter die Tabelle offen hatte, wurde die Dropdown so gespeichert. 

Jetzt habe ich das Problem, wenn ich im Namensmanager schaue, dann ist dort ständig ein Falscher Zellenbezug drinnen. Eigentlich ist die Hilfsliste für die Dropdown in AA6:AA , der Namensmanager sagt manchmal AF15:AF16 / CC18:CC19 ???????

Dropdown in P5 wird nicht mehr angezeigt.

Hier der erste Code :

Private Sub Workbook_Open()
    Call BenutzerModus
    Worksheets("Leistungsnachweis").Activate
    Worksheets("Leistungsnachweis").Activate
    Worksheets("Leistungsnachweis").Range("P5").Value = ""

    Dim wsMA As Worksheet
    Dim benutzer As String
    Dim istAdmin As Boolean
    Dim letzteZeile As Long
    Dim i As Long
    Dim zeileAA As Long
    Dim userGefunden As Boolean
    Const passwort As String = "1234"

    Set wsMA = ThisWorkbook.Sheets("Mitarbeiter")
    benutzer = Environ("Username")

    ' Blattschutz aufheben
    On Error Resume Next
    wsMA.Unprotect Password:=passwort
    On Error GoTo 0

    ' Spalte AA leeren
    wsMA.Range("AA6:AA1000").ClearContents

    ' Adminstatus prüfen
    istAdmin = False
    userGefunden = False
    letzteZeile = wsMA.Cells(wsMA.Rows.Count, "J").End(xlUp).Row

    For i = 6 To letzteZeile
        If Trim(wsMA.Cells(i, "J").Value) = benutzer Then
            userGefunden = True
            If LCase(Trim(wsMA.Cells(i, "G").Value)) = "ja" Then
                istAdmin = True
            End If
            Exit For
        End If
    Next i

    If Not userGefunden Then GoTo SchutzSetzen

    ' Spalte AA neu befüllen
    zeileAA = 6
    For i = 6 To letzteZeile
        If istAdmin Or Trim(wsMA.Cells(i, "J").Value) = benutzer Then
            wsMA.Cells(zeileAA, "AA").Value = wsMA.Cells(i, "B").Value
            zeileAA = zeileAA + 1
        End If
    Next i

    ' Neuen Bereichsnamen definieren
    On Error Resume Next
    Application.Names("dropdownListe").Delete
    On Error GoTo 0

    Application.Names.Add Name:="dropdownListe", _
        RefersTo:="=Mitarbeiter!AA6:AA" & (zeileAA - 1)

SchutzSetzen:
    wsMA.Protect Password:=passwort, UserInterfaceOnly:=True
End Sub



Hier der Zweite Code ( der markierte Bereich, da schmeißt es mich immer raus) :

Private Sub Worksheet_Activate()

    Const passwort As String = "1234"

    Dim wsMitarbeiter As Worksheet
    Dim letzteZeile As Long
    Dim aktuellerBenutzer As String
    Dim istAdmin As Boolean
    Dim sichtbareNamen As Collection
    Dim i As Long
    Dim Klarname As String
    Dim benutzernameTabelle As String
    Dim aaRow As Long
    Dim eintrag As String
    Dim istNochGueltig As Boolean
    Dim n As Name

    Set wsMitarbeiter = ThisWorkbook.Worksheets("Mitarbeiter")
    Set sichtbareNamen = New Collection

    ' Blattschutz aufheben
    On Error Resume Next
    wsMitarbeiter.Unprotect Password:=passwort
    On Error GoTo 0

    ' Aktuellen Benutzer ermitteln
    aktuellerBenutzer = Environ("Username")
    letzteZeile = wsMitarbeiter.Cells(wsMitarbeiter.Rows.Count, "J").End(xlUp).Row

    ' Adminstatus prüfen
    istAdmin = False
    For i = 6 To letzteZeile
        If LCase(Trim(wsMitarbeiter.Cells(i, "J").Value)) = LCase(Trim(aktuellerBenutzer)) Then
            If LCase(Trim(wsMitarbeiter.Cells(i, "G").Value)) = "ja" Then
                istAdmin = True
            End If
            Exit For
        End If
    Next i

    ' Sichtbare Namen sammeln
    For i = 6 To letzteZeile
        Klarname = Trim(wsMitarbeiter.Cells(i, "B").Value)
        benutzernameTabelle = Trim(wsMitarbeiter.Cells(i, "J").Value)

        If istAdmin Or LCase(benutzernameTabelle) = LCase(aktuellerBenutzer) Then
            If Klarname <> "" Then sichtbareNamen.Add Klarname
        End If
    Next i

    ' Spalte AA vorbereiten
    wsMitarbeiter.Range("AA6:AA1000").ClearContents
    aaRow = 6
    For i = 1 To sichtbareNamen.Count
        wsMitarbeiter.Cells(aaRow, "AA").Value = sichtbareNamen(i)
        aaRow = aaRow + 1
    Next i

    ' Dropdown löschen, wenn keine Namen
    If sichtbareNamen.Count = 0 Then
        Me.Range("P5").Validation.Delete
        Me.Range("P5").Value = ""
        Exit Sub
    End If

    ' Alle alten Namen mit "dropdownListe" löschen (lokal + global)
    For Each n In ThisWorkbook.Names
        If LCase(n.Name) Like "*dropdownListe" Then n.Delete
    Next n
    On Error Resume Next
    Application.Names("dropdownListe").Delete
    On Error GoTo 0

    ' Neuen Bereichsnamen anlegen (global, sauber)
    Application.Names.Add Name:="dropdownListe", _
        RefersTo:="=Mitarbeiter!AA6:AA" & (aaRow - 1)

    ' Dropdown in P5 setzen
    With Me.Range("P5").Validation
        .Delete
        .Add Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, _
            Formula1:="=dropdownListe"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With

    ' Aktuellen Eintrag prüfen
    eintrag = Trim(Me.Range("P5").Value)
    istNochGueltig = False
    For i = 1 To sichtbareNamen.Count
        If sichtbareNamen(i) = eintrag Then
            istNochGueltig = True
            Exit For
        End If
    Next i

    If Not istNochGueltig Then
        Me.Range("P5").Value = ""
    End If

    ' Blattschutz wieder aktivieren
    wsMitarbeiter.Protect Password:=passwort, UserInterfaceOnly:=True

End Sub


Wenn mir da jemand Helfen könnte ? Das wäre super nett 


Vielen Dank im vorraus

Gruß Daniel

[RPP63]

Moin!
Frage doch erstmal die KI!

Ernsthaft!
Die Fälle häufen sich, dass jemand eine Tapete reinklatscht, weil sein gefährliches Halbwissen nicht mit den Fehlern der KI schritthalten kann.

Es ist ja durchaus nachvollziehbar, dass man sich irgendwann an ein Forum richtet, wenn die KI nicht weiterhilft.
Vielleicht war die KI ja auch nur genervt, weil der hundertdrölfzigtausendste die Frage nach dem sicheren Verbergen von Informationen in einer Excel-Datei gestellt hat.
Es gibt hierzu Tausende Vorschläge im Netz (mindestens so viele, wie die Behauptung, dass die Erde eine Scheibe ist).
Jetzt macht die KI einen Vorschlag aufgrund ihres Algorithmus und ahnt nicht einmal, dass er sie getrogen hat …

Sorry für die harschen Worte, aber ich bin genervt!

Gruß Ralf

[Ralf A]

wer soll sich denn durch den Code wühlen? Zumal Du seit 2021 18 Beiträge eröffnet hast, Dich aber gerade mal zu einem einzigem Danke (2022) durchringen konntest... Nicht gerade motivierend...

Trenne Mitarbeiter und Leistungsnachweise. Beides in separate Dateien. Der Leistungsnachweis kann im MA Workbook oder in der MA DB  nachschauen und entsprechend reagieren.

[snb]

Danke für die fehlende Beispieldatei.

[Klaus-Dieter]

Hallo Daniel,

ich bin da ganz bei Ralf. Werde nicht versuchen, irgend einen KI-Quelltext gerade zu biegen. Stelle eine Beispieldatei ein, dann können wir sehen, wie man dir helfen kann.

[Daniel555]

Ich hatte ganz vergessen das wir ja hier in Deutschland sind. Das Land des erhobenen Zeigefingers. 

Erstmal irgendwelche Kommentare ablassen die keinen Menschen interessieren. Macht bitte eigene Beiträge auf und Spamt diese zu, danke.

Ich freue mich für euch das ihr im Leben nur Dinge angeht, die ihr auch mal gelernt habt. Heißt jeder müsste ja auch Koch sein, oder wer macht euch Abendbrot? 

Ist jedenfalls nicht meine Einstellung vom Leben. Ich gehe gerne neue Dinge an und lerne dazu. Excel und VBA sind Hobby, mehr nicht. Ich habe nicht darum gebeten das mir jemand ein komplexen VBA Code entwirft den ich dann verkaufen kann …. Lächerlich … 

Aber eben typisch deutsch, erstmal in die Tasten hauen. 

Wenn mir keiner helfen möchte oder kann, dann is das dich ok. Ich werde früher oder später schon eine Lösung finden für mein Problem. 


Wegen mir kann der Beitrag beendet werden …. Auf solch Art von Mitmenschen kann ich verzichten …

[slowboarder]

Jetzt habe ich das Problem, wenn ich im Namensmanager schaue, dann ist dort ständig ein Falscher Zellenbezug drinnen. Eigentlich ist die Hilfsliste für die Dropdown in AA6:AA , der Namensmanager sagt manchmal AF15:AF16 / CC18:CC19 ???????

das liegt daran, dass du die Formel für den Namenmanager mit relativen Zellbezügen schreiben lässt.
das funktioniert nur dann, wenn die Zelle, die diesen Namen verwendet, denn die relativen Zellbezüge gelten immer aus sicht der aktiven Zelle.
Du solltest die Formel auf jeden Fall mit absoluten Zelladressen schreiben ($-Zeichen) dann spielt es keine Rolle.

 Application.Names.Add Name:="dropdownListe", _
        RefersTo:="=Mitarbeiter!$AA$6:$AA$" & (zeileAA - 1)

an dieser Stelle müsstest du aber auch entscheiden, ob jetzt ein Admin, ein zugelassener Mitarbeiter, der seine Namen sehen darf oder ein Fremder am Rechner sitzt und dann die Zuweisung entsprechend ausgestalten.

Gruß Daniel

[Ralf A]

...Auf solch Art von Mitmenschen kann ich verzichten …

...die meisten von uns übrigens auch auf solche wie Dich... 

Auf gefühlte Unhöflichkeit mit echter reagieren... 

[Klaus-Dieter]

Hallo zusammen,

...die meisten von uns übrigens auch auf solche wie Dich... 

gibt es hier so etwas wie eine Foren-IL? Da wüsste ich einen Kandidaten.

[Kuwer]

Ja, gibt es, Klaus.

Gruß, Uwe