Excel VBA Button per doppelklick?

Moinsen,

Ich würde gerne einen versteckten Button erstelln, der folgendes Kann:

Sub CommandButton1_Click()

If ActiveSheet.ProtectContents = False Then

ActiveSheet.Protect Password:="+1516", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True

Else

ActiveSheet.Unprotect

End If

Jedoch würde ich ihn gerne nur per Doppelklick aktivieren lassen, da man sonst evt ausversehen drauf kommt.

3 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet

mchawk777

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Computer

20.08.2021, 10:49

Ein Doppelklick ist bei Windows ausschließlich zum Starten von Programmen da - nicht für solche Aktionen.

Besser wäre hier eine "Sind Sie sicher?"-Abfrage.

If MsgBox ("Sind Sie sicher?", vbYesNo) = vbYes Then
 [...Aktion ausführen...]
End If

Murnax

Beitragsersteller

20.08.2021, 11:05

Danke für die Gute Idee, gefällt mir sogar besser :)

mchawk777

20.08.2021, 11:08

@Murnax

Gerne - geht übrigens auch umgekehrt:

If MsgBox ("Sind Sie sicher?", vbYesNo) = vbNo Then Exit Sub

Dann wird die Routine sofort beendet. Viel mir eben auf die Schnelle nicht auf. 😉

Murnax

Beitragsersteller

20.08.2021, 12:02

@mchawk777

Ganz blöde frage, wo muss ich das denn einfügen, bzw wie?

hab jetzt einfach den command über dem:

If MsgBox("Blattschutz aufheben/aktivieren?", vbYesNo) = vbYes Then

aber dann kommt ja einmal die box sind sie sicher und wenn ich auf ja dann kommt die box mit Blattschutz aufgenen.

Aber wenn ich da dann wieder auf nein gehe is es ja trozdem ja.

Steh grad iwie auf dem schlauch.

mchawk777

24.08.2021, 16:09

@Murnax

Ganz blöde frage, wo muss ich das denn einfügen, bzw wie?

Sorry - die Frage ist mir durchgegangen.

Diese Art von Rückfrage sollte man sofort als ersten Befehl z. B. nach der Vairabeln-Definition einfügen.

Kann im Prinzip direkt unter

Sub OnClick_Button()

...oder so ähnlich. erfolgen.

Es soll ja sofort abgebrochen und keine weiteren Befehle ausgeführt werden.

daCypher

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Computer, programmieren

20.08.2021, 11:36

Dafür musst du einen Button bzw. besser ein Label (das lässt sich so gestalten, dass es nicht sichtbar ist) aus den "Active X Steuerelementen" nehmen. Wenn du auf der Registerkarte Entwicklertools bist, hast du beim Punkt "Einfügen" ja eine Liste mit Formularsteuerelementen und eine Liste mit Active X Steuerelementen.

Das Label kannst du dann an die Stelle schieben, die du haben willst, einen Rechtsklick drauf machen und auf "Code anzeigen" gehen. Dann geht der VBA-Editor auf und du hast über dem Code zwei Felder. Links der Name vom Label und rechts ein Feld, wo "Click" drinsteht. Bei dem "Click" kannst du die Liste aufmachen und "DblClick" auswählen. Dann wird eine neue Prozedur eingefügt, die bei einem Doppelklick ausgeführt wird und du kannst den Code einfügen.

Albin1990

21.08.2021, 14:29

Hallo

Gib den Befehl einfach unter DblClick rein ....

Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ActiveSheet.ProtectContents = False Then

  ActiveSheet.Protect Password:="+1516", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True

Else

  ActiveSheet.Unprotect

End If
End Sub

Bild zum Beitrag

Woher ich das weiß:eigene Erfahrung – Bei einer Frage ist Danke ein obligates Zeichen von Respekt

- (Computer, programmieren, Microsoft Excel)

Ähnliche Beiträge

Excel VBA Blattschutz Passwort umgangen?

Hallo,

Ich habe folgendes Problem.

Ich habe einen Button mit dem man den Blattschutz de/aktivieren kann.

Jedoch kann man das PW umgehen, indem man einfach das Fenster schliest, indem man das PW eingibt.

Hat da jemand eine ahnung, wie ich das ausbessern kann?

Macro:

Private Sub CommandButton1_Click()

If MsgBox("Blattschutz aufheben/aktivieren?", vbYesNo) = vbYes Then

Else: Exit Sub

[...Aktion ausführen...]

End If

On Error GoTo PW

If ActiveSheet.ProtectContents = True Then

ActiveSheet.Unprotect

' einblenden:

ActiveWindow.DisplayHeadings = True

Else

ActiveSheet.Protect Password:="+1516", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True

' ausblenden:

ActiveWindow.DisplayHeadings = False

End If

Exit Sub

PW:

MsgBox "Falsches Passwort"

End Sub

...zum Beitrag

Excel VBA Blattschutz ein und aus per Button?

Hallo allerseits,

ich bin gerade dabei einen Kalkulator mit Excel zu erstellen.

Dabei bin ich auf folgendes Problem gestoßen:

Ich möchte Das Blatt per Button entsperren, sperren und man sollte im gesperrten Zustand die Zeilen formatieren können.

AllowFormattingCells:=True

Sub Blattsperren()

On Error Resume Next

If ActiveSheet.ProtectContents = False Then GoTo Fehler

ActiveSheet.Unprotect

Exit Sub

Fehler:

ActiveSheet.Protect "+1516"

End Sub

Hat da jemand eine Idee, wie man die Formel richtig aufstellt?

Vielen Dank im Voraus

...zum Beitrag

Excel VBA Button Enable?

Hallo Freunde,

Ich habe einen Button in Excel implementiert, der sichtbar sein soll wenn meine Zelle A1 die Zahl 2 enthält.

Der Code dafür lautet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  On Error GoTo ErrHandler
  Dim rngButton1 As Integer
  rngButton1 = A1
  If rngButton1 = 2 Then
  CommandButton1.Enabled = False
  Else
  CommandButton1.Enabled = True
  End If
  Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub

Der Code funktioniert an und für sich, es kommt zu keiner Fehlermeldung.
Aber der Button bleibt egal was ich einstelle, Sichtbar.

Wo liegt der Fehler?

...zum Beitrag

Wie kann man in Access mehrere Filter per ODER verknüpfen?

Ich habe eine Access Datenbank-Tabelle mit den Einträgen Ersatzteilnummer, Materialtext, Typennummer, Sonstige Nummer und Kommentar.

Über ein Formular mit Suchfeld möchte ich mir Alle Datensätze anzeigen lassen, bei denen mindestens eine der Spalten meiner Datenbank den Suchbegriff enthält. Es sollen also alle Datensätze angezeigt werden bei denen die Eingabe im Materialtext vorkommt ODER in der Typennummer ODER im Kommentar usw.

Der Filter wie unten eingefügt funktioniert mehr oder weniger, jedoch habe ich so keine ODER Verknüpfung. Hat vielleicht jemand eine Idee, wie ich das realisieren könnte?

Vielen lieben Dank!! Max

If Len(Me!txtQSf) > 0 Then

Me.Filter = ""
       If Ersatzteilenummer Like "" & Me!txtQSf & "" Then
       Me.Filter = "Ersatzteilenummer LIKE '" & Me!txtQSf & "'"
       Me.FilterOn = True
    Else
        If Materialtext Like "*" & Me!txtQSf & "*" Then
            Me.Filter = "Materialtext LIKE '*" & Me!txtQSf & "*'"
            Me.FilterOn = True
        Else
                If Typennummer Like "*" & Me!txtQSf & "*" Then
                     Me.Filter = "Typennummer LIKE '*" & Me!txtQSf & "*'"
                     Me.FilterOn = True
                Else
                  If Kommentar Like "*" & Me!txtQSf & "*" Then
                      Me.Filter = "Kommentar LIKE '*" & Me!txtQSf & "*'"
                      Me.FilterOn = True
                  Else
                    If Sonstige_Nummer Like "*" & Me!txtQSf & "*" Then
                            Me.Filter = "Sonstige_Nummer LIKE '*" & Me!txtQSf & "*'"
                            Me.FilterOn = True
                    Else
                        Me.Filter = "Materialtext LIKE '*" & Me!txtQSf & "*'"
                        Me.FilterOn = True                              
     End If
     End If
     End If
     End If
     End If
Else
Me.Filter = ""
Me.FilterOn = False
End If

End Sub

...zum Beitrag

In Excel Makros aus aktiven Sheet löschen?

Ich Möchte ein Tabellenblatt neben das Original kopieren, in dem man nichts mehr ändern kann, aber anschliesssend die Sub Makros aus der Kopie Löschen, da sonnst die Datie zu groß wird. Das Kopieren funktioniert super, nur mit den Makros entfernen noch nicht so.

Das ist mein Code zum Kopieren, Danke

Sub NeuesTabBlatt()
' Monate Soll
 If MsgBox("Wollen Sie wirklich einen neuen Sollplan erstellen?", vbYesNo) = vbYes Then
 If InputBox("geben sie Bitte das Passwort zum Entsperren ein", "  Sollplanerstellung") = "1234" Then
        MsgBox "OK, der Sollplan wird erstellt"
 Else
 MsgBox "Hier kommst Du net rein!"
 ActiveSheet.Range("$A$1").Select
 Exit Sub
 End If
Application.ScreenUpdating = False
Application.Calculation = False
Dim NewName As String
ActiveWorkbook.Unprotect Password:="1234"
NewName = ActiveSheet.Range("$CW$1")
ActiveSheet.Copy After:=ActiveSheet
 ActiveSheet.Name = "Soll" & " " & ActiveSheet.Range("CW1")
  ActiveSheet.Range("AT127:AV134,AQ133:AS133, AT183:AV186, AT228:AV232").Clear
       ZeilenEinUndAusblenden
    ActiveSheet.EnableSelection = xlNoSelection
   ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.Visible = False
  ActiveWorkbook.Protect "1234", Structure:=True
  Application.Calculation = xlAutomatic
 Application.ScreenUpdating = True
 MsgBox "ein neues SOLL Tabellenblatt wurde erstellt"
 End If
 'BlätterSollEinAus
 ActiveSheet.Range("$A$1").Select
End Sub

...zum Beitrag

Excel VBA: Tabellenblätter bei gewissen Zellenwert ausblenden?

Hallo Zusammen,

Ich will mittels VBA ein Excel modifizieren, damit möglichst wenige Tabellenblätter angezeigt werden. In einem Tabellenblatt (z.B. "Auswahl") habe ich die Zellen C62, C88 und C114, die jeweils ein spezielles Tabellenblatt anzeigen sollen. Jedoch gibt es im Moment nur LZF-Meldungen.

Es soll jeweils bei "Yes" nichts angezeigt, bei "No" die entsprechende Tabelle eingeblendet werden.

Ansonsten sollen die "nicht betroffenen" Tabellen ausgeblendet bleiben

Hier der Code im Worksheet "DieseArbeitsmappe":

Private Sub Worksheet_Open()

'Beim Öffnen des Excels die betroffenen Blätter ausblenden
    ThisWorkbook.Worksheets("Tabelle4").Visible = False 
    ThisWorkbook.Worksheets("Tabelle5").Visible = False
    ThisWorkbook.Worksheets("Tabelle6").Visible = False
    
End Sub

In Blatt "Auswahl" (Tabelle7) habe ich folgenden Code:

Private Sub Worksheet_Change(ByVal Target As Range)

   

‘Hier sind vorher noch andere IF-Regeln hinterlegt, die nur Reihen in Tabelle7 ein/ausblenden

   

    If Range("C62").Value = "No" Then 'Tabellenblätter einblenden, sobald in der jeweiligen Zelle "No" ausgewählt wird

        ThisWorkbook.Worksheets("Tabelle6").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle6").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C88").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle5").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle5").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C114").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle4").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle4").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

End Sub

Weshalb gibt es jeweils einen Fehler und wie kann ich diesen am einfachsten beheben?

Vielen Dank, Michael

...zum Beitrag

VBA mehrere Textboxen außer XY auf Inhalt prüfen?

Hallo zusammen,

kann man für mehrere Textboxen bis auf Ausnahmen den gleichen Inhalt prüfen?

Zu Sache: Ich habe ein Userform mit einer Multiseite mit 10 Pages. Jeder Page hat 63 Textboxen, ergo 630 Textboxen im gesamten Userform.

Von diesen 630 Textboxen muss in 620 Textboxen geprüft werden, ob diese entweder leer sind oder eine Uhrzeit steht. Wenn dieses der Fall ist, dann ist alles Ok. Ansonsten soll entsprechend der Vorgang abgebrochen werden.

Die 620 Textboxen haben alle individuelle Namen wie (AN1t1a, AN1t1e, AN1t2a usw.) Dies ist nach einem bestimmten Muster.

Die restlichen Textboxen, die NICHT geprüft werden sollen haben Namen wie (AN_Name1, AN_Name2, AN_Name3 usw. bis 10).

Wie können nun alle 620 Textboxen auf folgendes Format geprüft werden:

Private Function CheckTime(ByVal txt As String) As Boolean

If txt.Length <> 5 or txt.Length <> 0 Then
Return False
End If

If txt(0) >= "3" Then
Return False
End If

If txt(0) = "2" AndAlso txt(1) >= "4" Then
Return False
End If

If txt(2) <> ":" Then
Return False
End If

If txt(3) = "0" AndAlso txt(4) <> "0" Then
Return False
End If

If txt(3) = "1" AndAlso txt(4) <> "5" Then
Return False
End If

If txt(3) = "2" Then
Return False
End If

If txt(3) = "3" AndAlso txt(4) <> "0" Then
Return False
End If

If txt(3) = "4" AndAlso txt(4) <> "5" Then
Return False
End If

If txt(3) > "4" Then
Return False
End If

Return True
End Function

Falls die Prüfung auf die korrekte Uhrzeit fehlerhaft ist oder auch einfacher geht, nehme ich die Hilfe auch gerne an :) Erlaubte Uhrzeiten sollen im Forma HH:MM sein und im Viertelstunden Takt (10:00, 10:15, 10:30, 10:45) erlaubt sein. Nur Zahlen sind nicht möglich, da es auch einen Doppelpunkt gibt ;)

Gruß

...zum Beitrag

VBA Dateiauswahl - Bei Abbruch Laufzeitfehler 5, jemand Ideen?

Hallo zusammen,

was müsste ich hinzufügen, um den Laufzeitfehler 5 zu umgehen? Wenn ich den VBA-Code ausführe, öffnet sich das Fenster für den Import von DAT-Dateien. Drücke ich auf Abbrechen, erscheint der Laufzeitfehler 5. Vermerkt wird der Code "Set F = fs.GetFolder(strPfad)". Wo und welchen Code müsste ich hinzufügen, um den Fehler zu beheben? Vielen Dank im Voraus. :)

Sub Schaltfläche1_Klicken()
'
'
'*** Öffnen von DAT-Dateien
Dim strText As String, strFilter As String

strText = "Bitte eine Auswertung Auswählen"
strFilter = "DAT-Dateien (*.DAT), *.DAT"""
strAuswahl = Application.GetOpenFilename(strFilter, 1, strText)
strPfad = Pfad_ermitteln(strAuswahl)
'
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(strPfad)
Set fc = F.Files

If ActiveSheet Is Nothing Then Workbooks.Add
For Each File In fc
    Zeile = Cells(65000, 1).End(xlUp).Row + 2
    strEinfügen = Cells(Zeile, 1).Address
    strAuswahl = File.Path

    'Einfügen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strAuswahl _
        , Destination:=Range(strEinfügen))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
  End With
  Range(strEinfügen).QueryTable.Delete
Next
End Sub
_______________________________

 Function Pfad_ermitteln(ByVal strAuswahl As String) As String
 
 For i = Len(strAuswahl) To 1 Step -1
    If Mid(strAuswahl, i, 1) = "\" Then
        Pfad_ermitteln = Left(strAuswahl, i - 1)
        Exit Function
    End If
Next
End Function

...zum Beitrag

"Loop ohne Do" Hilfe!?

Private Sub CommandButton1_Click()

Dim a, b, c, d As Integer

a = 0

Do While Tabelle1.Cells(6, 3 + r) <> ""

b = Tabelle1.Cells(6, 3 + r)

d = Tabelle1.Cells(6, 3 + r + 1)

If b = "A" Or "a" Or "Ä" Or "ä" Then

c = 1

If b = "B" Or "b" Then

c = 2

If b = "G" Or "g" Then

c = 3

If b = "D" Or "d" Then

c = 4

If b = "E" Or "e" Then

c = 5

If b = "U" Or "u" Or "Ü" Or "ü" Or "V" Or "v" Or "W" Or "w" Then

c = 6

If b = "Z" Or "z" Then

c = 7

If b = "H" Or "h" Then

c = 8

If b = "C" Or "c" And d = "H" Or "h" Then

c = 8

End If

Tabelle1.Cells(7, 3 + r) = c

r = r + 1

Loop

End Sub

--------------------------------------------------------------------------------------------------------------------------------------

Es ist nochnicht fertig aber ich wollte es testen und weiß nicht was ich falsch gemacht habe... kann mir wer helfen?

...zum Beitrag

VBA | UserForm öffnen, sobald Excel-Zelle (die eine Formel enthält) = 2?

Hallo,

Excel-VBA....

ich benötige Hilfe beim Thema UserForm öffnen und ständige Abfrage.

Ich habe eine Zelle mit einer Formel, der Wert, welcher raus kommt soll verglichen werden und bei z.b höher als 2 soll eine User Form geöffnet werden.

Kann mir da wer helfen? Ich bin komplett auf dem Holzweg..

Der Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$T$6" Then
If UCase(Target.Value) > 2 Then NewUserForm.Show
End If

End Sub

Devo

...zum Beitrag

Wie kann ich in VBA-Excel einen Filter setzen über einer CheckBox?

Hi,

ich suche eine einfachere Lösung für meine UserForm um über CheckBoxen meine Tabelle zu Filtern.

Im grunde möchte ich also, wenn ich einen Wert ankreuze soll dieser Gefiltert werden.

Wie im Beispiel (unten):

FKEP und KKEP angekreuzt = FKEP und KKEP angezeigt.

Nur KKEP angekreuzt = nur KKEP angezeigt

"Wert" der gefiltert werden soll | CheckBox Name
 FKEP                              CBFilterFKEP
 KKEP                              CBFilterKKEP
 KfB                               CBFilterKfB
 ausgesch.                         CBFilterausgesch
 beendet                           CBFilterbeendet
 EQ - KfB                          CBFilterEQKfB
 EQ - FKEP                         CBFilterEQFKEP

Mein momentaner Code schaut wiefolgt aus:

    Private Sub CBFilterFKEP_Click()

If CBFilterFKEP = True Then

    Sheets("Gesamtdaten").Range("$A$2:$EQ$502").AutoFilter Field:=3, Criteria1:=Array( _
    "FKEP"), Operator:=xlFilterValues

If CBFilterKKEP = True Then

    Sheets("Gesamtdaten").Range("$A$2:$EQ$502").AutoFilter Field:=3, Criteria1:=Array( _
    "FKEP", "KKEP"), Operator:=xlFilterValues

End If
End If
End Sub

Private Sub CBFilterKKEP_Click()

    If CBFilterKKEP = True Then

        Sheets("Gesamtdaten").Range("$A$2:$EQ$502").AutoFilter Field:=3, Criteria1:=Array( _
        "KKEP"), Operator:=xlFilterValues

    If CBFilterFKEP = True Then

        Sheets("Gesamtdaten").Range("$A$2:$EQ$502").AutoFilter Field:=3, Criteria1:=Array( _
        "KKEP", "FKEP"), Operator:=xlFilterValues

    End If
    End If
    End Sub

Soweit so gut ... nun habe ich aber nur FKEP und KKEP "abgestimmt" ... muss ich nun alle 5 Werte auch "abstimmen" ? Das wird nämlich ein SEHR langer code ... und ich könnte wetten das es in VBA viel leichter geht ...

Hat wer eine Idee von euch?

MfG Tim

...zum Beitrag

Excel Aktive Zelle auslesen VBA?

Ich habe eine Tabelle in Excel erstellt. Nun ist dort ein Button, der auf Knopfdruck ein Makro ausführt, das, wenn die aktuelle entweder B2 oder C6 oder D10 ist, in diese Zelle eine 5 einträgt. Wie kann ich das mit einer If-Anweisung umsetzen (mithilfe von Or-Operatoren)?

Also ich meine so in die Richtung

If ActiveCell = B2 Or C6 Or D10 Then

Active Cell.Value = 5

Else

MsgBox("Das Argument ("5") ist nicht mit der aktuellen Zelle kompatibel.")

End If

Nur dass das oben nie funktioniert, weil ich nicht weiß, wie ich mehrere Zellen als richtig ansehen lassen kann.

Kann mir jemand das richtige Makro zeigen?

...zum Beitrag

UserForm durch CommandButton schließen

Hallo zusammen,

ich habe eine UserForm mit verschiedenen OptionButtos. Durch klicken auf einen CommandButton soll zum einen je nach ausgewähltem OptionButton eine neue UserForm geöffnet werden, dass ist kein Problem, und zum anderen die aktuelle UserForm geschloßen werden. Wie bekomme ich das hin?

Hier der Code, den ich bisher habe:

Private Sub CommandButton1_Click()

If OptionButton1 = True Then
    UserForm2.Show
ElseIf OptionButton2 = True Then
    UserForm3.Show
ElseIf OptionButton3 = True Then
    UserForm4.Show
ElseIf OptionButton4 = True Then
    UserForm5.Show
ElseIf OptionButton5 = True Then
    UserForm6.Show
ElseIf OptionButton6 = True Then
    UserForm7.Show
ElseIf OptionButton7 = True Then
    UserForm8.Show
ElseIf OptionButton8 = True Then
    UserForm9.Show
ElseIf OptionButton9 = True Then
    UserForm10.Show
ElseIf OptionButton10 = True Then
    UserForm11.Show
ElseIf OptionButton11 = True Then
    UserForm12.Show
End If

End Sub

...zum Beitrag

Excel VBA UserForm "Passwort ändern" funktioniert nicht?

Ich komme echt nicht weiter bei so einem einfachen Code! :(

Das Problem ist, dass die UserForm einmal funktioniert, aber beim zweiten Mal sagt er "Das Passwort ist nicht korrekt", obwohl es das eigentlich sein müsste. Per Direktbereich abgefragt ergibt sich dann immer, dass das Passwort auf "" steht. Findet jemand im Code den Fehler?

PS: "NeuesPasswort1" steht für die obere, "NeuesPasswort2" für die untere Reihe.

Option Explicit

Sub CheckBoxAltesPasswort_Click()
  If CheckBoxAltesPasswort.Value = True Then
    TextBoxAltesPasswort.PasswordChar = ""
    Else
      TextBoxAltesPasswort.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort1_Click()
  If CheckBoxNeuesPasswort1.Value = True Then
    TextBoxNeuesPasswort1.PasswordChar = ""
    Else
      TextBoxNeuesPasswort1.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort2_Click()
  If CheckBoxNeuesPasswort2.Value = True Then
    TextBoxNeuesPasswort2.PasswordChar = ""
    Else
      TextBoxNeuesPasswort2.PasswordChar = "*"
  End If
End Sub

Sub CommandButtonAbbrechen_Click()
  Me.Hide
End Sub

Sub CommandButtonSpeichern_Click()
  If TextBoxAltesPasswort.Value <> AltesPasswort Then
    MsgBox ("Das Passwort ist nicht korrekt.")
    Exit Sub
  End If
  If TextBoxNeuesPasswort1.Value <> TextBoxNeuesPasswort2.Value Then
    MsgBox ("Die Passwörter stimmen nicht überein.")
    Exit Sub
  End If
  If Len(TextBoxNeuesPasswort1.Value) < 5 Then
    MsgBox ("Bitte wählen Sie ein Passwort mit mindestens 5 Zeichen.")
    Exit Sub
  End If
  NeuesPasswort = TextBoxNeuesPasswort1.Value
  Passwort = NeuesPasswort
  Me.Hide
End Sub

Sub UserForm_Activate()
  AltesPasswort = Passwort
End Sub

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen