Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Passwortschutz per Button

Passwortschutz per Button
05.01.2018 00:49:57
Marco
Guten Abend,
ich habe ein kleines Problem mit meinem Passwortschutz. Ich möchte per Button, welcher auf mehreren Tabellenblättern vorhanden ist, ein Passwort setzen oder entfernen. Beim betätigen ändert sich die Farbe, Position, und der Text des Buttons (was auch funktioniert). Aktuell sieht mein Code für jede so aus:
Sub ON_BUTTON()
Dim Passwort As String
Dim wks As Worksheet
Passwort = Application.InputBox("Bitte Passwort eingeben!")
If Passwort = "Test" Then
Sheets("Settings").Protect Password:="Test"
Sheets("Settings").Protect userinterfaceonly:=True, Password:="Test"
Sheets("Settings").EnableAutoFilter = True
Sheets("Settings").EnableOutlining = True
Sheets("Settings").EnableSelection = xlUnlockedCells
Sheets("Database").Protect Password:="Test"
Sheets("Database").Protect userinterfaceonly:=True, Password:="Test"
Sheets("Database").EnableAutoFilter = True
Sheets("Database").EnableOutlining = True
Sheets("Database").EnableSelection = xlUnlockedCells
usw........
End If
For Each wks In Worksheets
With wks.Shapes("Button")
.IncrementLeft 30                        'Position / Hier anpassen!
.TextFrame.Characters.Text = "ON"        'Button Text / Hier anpassen!
.Fill.ForeColor.RGB = RGB(0, 153, 0)     'Farbe / Hier anpassen!
.OnAction = "OFF_BUTTON"
End With
Next
Range("A1").Select
End Sub
Aber wie kann ich diesen Code reduzieren das ich nicht für jede Seite die gleichen 5 Zeilen schreiben muss bzw. verbessern?

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Passwortschutz per Button
05.01.2018 01:00:06
Sepp
Hallo Marko,
genau so wie du es bei den Buttons bereits machst.
Sub ON_BUTTON()
Dim Passwort As String
Dim wks As Worksheet

Passwort = Application.InputBox("Bitte Passwort eingeben!")

If Passwort = "Test" Then
  For Each wks In Worksheets
    With wks
      .Protect userinterfaceonly:=True, Password:="Test"
      .EnableAutoFilter = True
      .EnableOutlining = True
      .EnableSelection = xlUnlockedCells
      With .Shapes("Button")
        .IncrementLeft 30                        'Position / Hier anpassen!
        .TextFrame.Characters.Text = "ON"        'Button Text / Hier anpassen!
        .Fill.ForeColor.RGB = RGB(0, 153, 0)     'Farbe / Hier anpassen!
        .OnAction = "OFF_BUTTON"
      End With
    End With
  Next
End If
End Sub

Gruß Sepp

Anzeige
AW: Passwortschutz per Button
05.01.2018 01:32:29
Marco
Danke für deine Hilfe Sepp. Leider funktioniert es noch nicht. Ich erhalte immer diese Meldung:
Fehler beim Kompilieren: Sub oder Function nicht definiert
AW: Passwortschutz per Button
05.01.2018 04:29:11
Sepp
Hallo Marco,
also ich habs bei mir getestet und es funktioniert, in welcher Zeile kommt denn die Meldung?
Gruß Sepp

AW: Passwortschutz per Button
05.01.2018 14:38:37
Marco
Hi Sepp,
jetzt kommt die Meldung: Fehler beim Kompilieren: Variable nicht definiert. Woran kann das denn liegen? Das ist der ganze Code für die On/Off Funktion.
Option Explicit
Sub ON_BUTTON()
Dim Passwort As String
Dim wks As Worksheet
Passwort = Application.InputBox("Bitte Passwort eingeben!")
If Passwort = "Test" Then
For Each wks In Worksheets
With wks
      .Protect userinterfaceonly:=True, Password:="Test"
      .EnableAutoFilter = True
      .EnableOutlining = True
      .EnableSelection = xlUnlockedCells
      With .Shapes("Button")
        .IncrementLeft 30 'Position / Hier anpassen!
        .TextFrame.Characters.Text = "ON" 'Button Text / Hier anpassen!
        .Fill.ForeColor.RGB = RGB(0, 153, 0) 'Farbe / Hier anpassen!
        .OnAction = "OFF_BUTTON"
End With
End With
  Next
End If
End Sub
Sub OFF_BUTTON()
Dim wks As Worksheet
Dim Passwort As String
For Each wks In Worksheets
With wks
.Unprotect Password:="Test"
      With .Shapes("Button")
.IncrementLeft -30                        'Position / Hier anpassen!
.TextFrame.Characters.Text = "OFF"        'Button Text / Hier anpassen!
.Fill.ForeColor.RGB = RGB(255, 1, 0)     'Farbe / Hier anpassen!
.OnAction = "ON_BUTTON"
End With
End With
  Next
End If
End Sub

Anzeige
AW: Passwortschutz per Button
05.01.2018 15:17:18
Sepp
Hallo Marco,
das End If am Ende hat der Kompiler sicher angezeigt!
Sub ON_BUTTON()
Dim Passwort As String
Dim wks As Worksheet

Passwort = Application.InputBox("Bitte Passwort eingeben!")

If Passwort = "Test" Then
  For Each wks In Worksheets
    With wks
      .Protect userinterfaceonly:=True, Password:="Test"
      .EnableAutoFilter = True
      .EnableOutlining = True
      .EnableSelection = xlUnlockedCells
      With .Shapes("Button")
        .IncrementLeft 30 'Position / Hier anpassen!
        .TextFrame.Characters.Text = "ON" 'Button Text / Hier anpassen!
        .Fill.ForeColor.RGB = RGB(0, 153, 0) 'Farbe / Hier anpassen!
        .OnAction = "OFF_BUTTON"
      End With
    End With
  Next
End If
End Sub

Sub OFF_BUTTON()
Dim wks As Worksheet
Dim Passwort As String

For Each wks In Worksheets
  With wks
    .Unprotect Password:="Test"
    With .Shapes("Button")
      .IncrementLeft -30                        'Position / Hier anpassen!
      .TextFrame.Characters.Text = "OFF"        'Button Text / Hier anpassen!
      .Fill.ForeColor.RGB = RGB(255, 1, 0)     'Farbe / Hier anpassen!
      .OnAction = "ON_BUTTON"
    End With
  End With
Next
End Sub

Gruß Sepp

Anzeige
AW: Passwortschutz per Button
05.01.2018 15:26:41
Marco
Jetzt heißt es wieder "Sub oder Function nicht definiert". Wo sollte den der Code stehen? Ich habe ihn in ein leeres Modul gestellt.
AW: Passwortschutz per Button
05.01.2018 15:46:29
Sepp
Hallo Marco,
also irgend etwas machst du komplett falsch. oder es st mit deiner Datei etwas nicht in Ordnung!
Der Code gehört in ein allgemeines Modul.
Schau mal im VBA-Editor, unter 'Extras' > 'Verweise', ob da irgendwo 'NICHT VORHANDEN' steht und mach ggf. den Haken dort raus.
Gruß Sepp

AW: Passwortschutz per Button
05.01.2018 16:38:38
Marco
Servus Sepp,
ich habe nachgeschaut, aber nichts gefunden. Ich lade jetzt mal die Datei hoch. Keine Ahnung woran das liegt das ist echt komisch
https://www.herber.de/bbs/user/118707.xlsm
Anzeige
AW: Passwortschutz per Button
05.01.2018 17:10:17
Sepp
Hallo Marco,
das Problem war ein geschützte Leerzeichen (ASC 160) vor den With-Anweisungen.
Hat der Kompiler aber angezeigt und auch das dieses Schlüsselwort nicht blau gefärbt war, hättest du erkennen können.
Ich habe deine Buttons ein wenig 'umgebaut'! Die Formen sind gruppiert und auch auf den Hintergrund kann man jetzt klicken. Es gibt auch nur mehr ein Makro für beide Zustände.
https://www.herber.de/bbs/user/118709.xlsm
Gruß Sepp

Anzeige
AW: Passwortschutz per Button
05.01.2018 22:37:16
Marco
Danke Sepp,
das habe ich echt nicht gesehen blau und schwarz erkennt man auf meinen Bildschirm nicht so gut. Aber als ich deinen Code kopiert habe war ein paar stellen rot markiert die habe ich dann gelöscht und einfach nochmal neu geschrieben. Kann es sein dass das das Problem war? Die jetztige Datei von dir funktioniert, aber der Code sieht ganz anders aus wie vorher und ich kann irgend ein Passwort eingeben es funktioniert irgendwie jedes xD. Danke schon mal für deine Hilfe =)
AW: Passwortschutz per Button
06.01.2018 09:37:47
Sepp
Hallo Marco,
sorry, hatte den Teil der Passwortprüfung vergessen.
' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub ON_OFF_BUTTON()
Dim Passwort As String
Dim wks As Worksheet

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

For Each wks In Worksheets
  With wks
    If .ProtectContents Then
      If Passwort = "" Then Passwort = Application.InputBox("Bitte Passwort eingeben!")
      If Passwort = "Test" Then
        .Unprotect "Test"
        With .Shapes("Button")
          .Left = wks.Shapes("Frame").Left + wks.Shapes("Frame").Width - .Width - 2
          .Top = wks.Shapes("Frame").Top + 3
          .TextFrame.Characters.Text = "OFF" 'Button Text / Hier anpassen!
          .Fill.ForeColor.RGB = RGB(255, 0, 0) 'Farbe / Hier anpassen!
        End With
      Else
        MsgBox "Passwort ist falsch!"
        Exit Sub
      End If
    Else
      .Protect userinterfaceonly:=True, Password:="Test"
      .EnableAutoFilter = True
      .EnableOutlining = True
      .EnableSelection = xlUnlockedCells
      With .Shapes("Button")
        .Left = wks.Shapes("Frame").Left + 2
        .Top = wks.Shapes("Frame").Top + 3
        .TextFrame.Characters.Text = "ON" 'Button Text / Hier anpassen!
        .Fill.ForeColor.RGB = RGB(0, 153, 0) 'Farbe / Hier anpassen!
      End With
    End If
  End With
Next

ErrorHandler:
DoEvents
With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With
End Sub

Gruß Sepp

Anzeige
AW: Passwortschutz per Button
06.01.2018 18:18:00
Marco
Sepp danke für deine Hilfe,
der Code wird ja von mal zu mal größer. Welches Programm verwendest du denn? Jedes mal wenn ich deinen Code kopiere funktioniert das Makro nicht und mir werden rote Stellen angezeigt. Selbst wenn ich diese lösche und neu schreibe verschwinden zwar die roten Markierungen aber der Code funktioniert trotzdem nicht. Woran liegt das?
https://www.herber.de/bbs/user/118735.xlsm
AW: Passwortschutz per Button
06.01.2018 18:41:40
Sepp
Hallo Marco,
die Frage ist eher, wie kopierst und fügst du den Code ein?
Ich kann den Code einfach kopiere und im VBE einfügen und er funktionier bestens.
Bei dir waren wieder 200! geschützte Leerzeichen im Code.
Die kann man aber einfach durch Suchen und Ersetzen löschen!
Du findest den Code zu lang? etwas über 40 Zeilen inkl Fehlerbehandlung sind nun wohl nicht gerade viel.
Und du hast meine vorherigen Hinweise nicht beachtet, die Shapes entsprechend benennen und Gruppieren, sonst kann es nicht funktionieren!
https://www.herber.de/bbs/user/118736.xlsm
Gruß Sepp

Anzeige
Danke für deine Geduld
06.01.2018 18:56:01
Marco
Sepp ich markiere ganz normal den Code im Forum mit STRG+c und füge ihn ein. Keine Ahnung was da bei mir schief geht. Ich kann beim kopieren auch nicht auswählen "nur Werte kopieren".
Ich sehe auch nicht die geschützten Leerzeichen. Kann man die denn durch irgendeine Option in den Einstellungen sichtbar machen?
Auf jeden Fall funktioniert es jetzt und nochmals danke =)
AW: Danke für deine Geduld
06.01.2018 19:33:09
Sepp
Hallo Marco,
liegt möglicherweise am Browser.
Geschützte Leerzeichen sind unsichtbar, im VBA-Editor kann man sie durch Ersetzen alle auf einmal löschen, dazu den gesamten Text markieren > STRG+H bei Suchen ALT+160 eingeben und bei Ersetzen nicht, dann alle Ersetzen.
Manchmal hilft der Umweg über Word, also erst den kopierten Taxt in Word eingeben und von dort nochmals kopieren und im Editor einfügen.
Gruß Sepp

Anzeige
AW: Passwortschutz per Button
05.01.2018 16:43:19
Marco
Sorry in der anderen Datei stand der Code nicht im Modul. In dieser Datei ist es jetzt an der richtigen Stelle.
https://www.herber.de/bbs/user/118708.xlsm

Links zu Excel-Dialogen

Frame InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige