Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

CommandButton mit Passwort belegen





Frage

Hallo Allerseits, ich möchte gerne erneut eine Anfrage an die fleißigen Helfer richten: Wie kann ich einen CommandButton programmieren, so dass nach einem Klick auf den Button ein Passwort eingegeben werden muss, bevor der Code ausgeführt wird? Vielen Dank im voraus für die Hilfe! Gruß Daniel

Antwort 1 von fedjo

Hallo Daniel,
schau mal auf die Seite:
http://www.herber.de/forum/archiv/188to192/t188709.htm

Gruß
fedjo

Antwort 2 von daniel-s

Hallo fedjo,

vielen Dank für den Tipp.

Leider habe ich das gleiche Problem wie der Kollege. Nach der korrekten Eingabe des Passwortes bricht die Prozedur ab und der weitere Code wird nicht mehr ausgeführt.

Kannst Du mir da weiterhelfen?

Gruß
Daniel

Antwort 3 von daniel-s

Hallo Allerseits,

Nun startet zwar die Prozedur, wenn man das korrekte Passwort eingibt. Allerdings startet sie auch, wenn man gar kein Passwort eingibt, das Feld als Blank ist.

Wie kann ich das ausschließen? Unten ist der Code auf der UserForm:

Vielen Dank für die Hilfe.


Private Sub UserForm_Initialize()
TextBox1.Text = " "
TextBox1.PasswordChar = "*"

End Sub

Private Sub commandbutton1_click()
Dim OFFICE As Worksheet

constpw = "hallo"

If TextBox1.Text = pw Then

Sheets("OFFICE").Select

UserForm1.Hide

End If

UserForm1.Hide
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub

Antwort 4 von coros

Hallo Daniel,

mit nachfolgendem Code sollte es funktionieren. Kopiere den VBA-Code in das Projekt der UserForm.

Option Explicit

Private Sub CommandButton1_Click()
Const pw = "hallo"
If TextBox1.Text = pw Then
Sheets("OFFICE").Select
End If

UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()
With TextBox1
.Text = " "
.PasswordChar = "*"
End With
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub


Kurze Frage noch, benötigst Du aus der UserForm nach dem sie ausgeblendet wurde noch irgend welche Informationen? Wenn nicht, wäre es besser, wenn Du anstelle der .Hidde -Methode die Unload- Methode verwenden würdest, da dann die UserForm richt geschlossen und nicht nur ausgeblendet wird. Ersetze alle Einträge, die

UserForm1.Hide
UserForm1.Hide


lauten durch die Zeile

Unload Me


Ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von daniel-s

Hallo Coros,

funktioniert bestens. Vielen Dank!

Eine weitere Frage:

Ich möchte gerne eine Inputbox generieren und die eingegebene Zeichenfolge (Name einer externen Datei) einer Variablen zuweisen und diese Variable dann in einem Makro als Dateiname verwenden.

Ich habe zwar schon einiges kapiert, aber mit dem Code hapert es noch ein wenig...

Kannst Du bitte helfen?

Gruß
Daniel

Antwort 6 von coros

Hallo Daniel,

nachfolgend ein Makro, dass eine Inputbox zur Eingabe öffnet. Der Text, der eingegeben wird, wird in die Variable "Dateiname" zuzüglich der Dateiendung ".xls" gespeichert. In diesem Makro erscheint dann eine Bildschirmmeldung mit dem eingegebenen Text und der Endung. Kopiere das Makro in ein StandardModul.

Option Explicit

Sub Dateiname_über_Inputboxeingabe()
Dim Dateiname As String
Dateiname = InputBox("Bitte geben Sie den Dateinamen ein") & ".xls"
MsgBox Dateiname
End Sub


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 7 von daniel-s

Hallo Oliver,

diese Forum ist Gold wert.

Kann Excel den Sourcedateiname selbständig ermitteln und einer Variablen zuweisen? Oder brauche ich dafür eine zweite Inputbox? Kann man die Inputboxen durchnummerieren?

Hintergrund ist, dass sowohl Source- als auch Zieldatei wechselnde Namen haben.

Mfg
Daniel

Antwort 8 von coros

Hallo Daniel,

was bitte schön soll ein "Sourcedateiname " sein?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 9 von daniel-s

Hallo Oliver,

der Name der Quelldatei. Die Datei, aus der ich Daten in die Zieldatei kopieren möchte.

Gruß
Daniel

Antwort 10 von coros

Hallo daniel,

und warum schreibst Du dann nicht einfach Quelldatei?
So ganz verstehe ich nicht, was Du machen möchtest, bzw. was Du in AW7 geschrieben hast. Du müsstest das nochmal etwas anders erklären. Vermeide dabei aber wenn möglich solche Begriffe wie "Sourcedateiname" da dass eher verwirrend als hilfreich ist.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 11 von daniel-s

Hallo Oliver,

geht klar.

Ich möchte Daten von einer Datei in eine andere Datei kopieren.

Dabei ändert sich der Dateiname bei beiden Dateien jeden Monat, da jeweils der Monat mit in den Dateinamen aufgenommen wird.

Deshalb möchte ich gerne eine komfortable Abfrage erstellen, in die man die aktuellen Namen der beiden Dateien schreiben muss, bevor der Kopiervorgang losgeht. Eine Lösung in der Form, dass man die beiden Namen jeweils in eine Zelle in der Quelldatei schreibt und diese Info dann an die Variablen übergibt finde ich weniger schön als eine InputBox. Daher die Frage nach den InputBoxen und der Übergabe der Inputwerte an Variablen.

Bester Gruß
Daniel

Antwort 12 von coros

Hallo Daniel,

nenn doch mal einen Dateinamen der Quell- und Zieldatei. Eventuell kann man das auch noch anders lösen. Ansonsten schreibst Du in den Code einfach 2 Inputboxen hintereinander. Nur der Variablenname muss sich ändern. Als Beispiel z.B. so:

Option Explicit

Sub Dateiname_über_Inputboxeingabe()
Dim Quelldatei As String, Zieldatei As String
Quelldatei = InputBox("Bitte geben Sie den Dateinamen, aus der die Daten kopiert werden sollen ein") & ".xls"
Zieldatei = InputBox("Bitte geben Sie den Dateinamen, in das die Daten kopiert werden sollen ein") & ".xls"
MsgBox Quelldatei & " , " & Zieldatei
End Sub



MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 13 von daniel-s

Hallo Oliver,

Danke schon mal für die Antwort. Ihr Supporter leistet hier echt tolle Arbeit. Mit Excel kann ich zwar sehr gut, VBA hatte ich aber bisher nicht gemacht.

ALso die Quelldatei heißt

Contracts of Employment [Schiffsname + Monat]
fester Teil variabler Teil

die Zieldatei heißt

SHIP ACCOUNTING [Schiffsname + Monat]
fester Teil variabler Teil

Dazu besteht leider die Möglichkeit, dass der Nutzer auch eine andere Kombination nutzen könnte, da man ihm ein Format zwar vorschreiben, aber ihn nicht zwingen kann.

Du denkst daran, den festen Teil als Erkennungsmerkmal zu nutzen?

Gruß
Daniel

Antwort 14 von coros

Hallo Daniel,

leider hast Du nicht dazugeschrieben, ob es sich bei dem variablen Namen, speziell den Monatsnamen, um den des aktuellen Monats handelt. Daher kommt hier mal eine Variante, in der nacheinander ein Dialogfenster geöffnet wird, in dem man einmal die Quelldatei und bei dem anderen die Zieldatei auswählen kann. Die ausgewählten Dateinamen werden in die Variablen "Quelldatei" und "Zieldatei" geschrieben. In diesem Beispiel wird bei Auswahl beider Dateien eine Bildschirmmeldung mit den Dateinamen angezeigt. Bei Dir müsste an der Stelle, an der sich der Befehl für die Messagebox (MsgBox) befindet, Dein Code für das kopieren usw. rein.

 Option Explicit

Sub Dateiauswahl()
Dim Quelldatei$, Zielldatei$
Rem: Dialogfenster zur Auswahl der Quelldatei öffnen
Quelldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Quelldatei auswählen...")
Rem: Dialogfenster zur Auswahl der Zielldatei öffnen
Zielldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Zieldatei auswählen...")
Rem: Wenn entweder Quelldatei oder Zieldatei nicht ausgewählt wurde, Prozedur beenden
If Dir(Quelldatei) = "" Or Dir(Zielldatei) = "" Then Exit Sub
Rem: Wenn Quelldatei und Zieldatei ausgewählt wurden, in deisem Beispiel MsgBox mit den Dateinamen anzeigen
If Dir(Quelldatei) <> "" And Dir(Zielldatei) <> "" Then
MsgBox Quelldatei & " , " & Zielldatei
End If
End Sub 


Ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 15 von daniel-s

Hallo Oliver,

genau nach der Lösung habe ich gesucht.

Muss ich zu Beginn noch die Quell- und Zieldatei als Workbook deklarieren?

Beim ersten Aufruf (Windows("Zieldatei").Activate) erscheint die Fehlermeldung: Index außerhalb des gültigen Bereichs. Laufzeitfehler 9.

Sub Data_Transfer()
Dim Quelldatei$, Zieldatei$

Quelldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Quelldatei auswählen...")
Zieldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Zieldatei auswählen...")

If Dir(Quelldatei) = "" Or Dir(Zieldatei) = "" Then Exit Sub

If Dir(Quelldatei) <> "" And Dir(Zieldatei) <> "" Then
Sheets("INTERFACE").Activate
Range("A9:C18").Copy
Windows("Zieldatei").Activate
Sheets("CREW_DATA").Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("E9:L18").Copy
Windows("Zieldatei").Activate
Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("M9:M18").Copy
Windows("Zieldatei").Activate
Range("U3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("N9:N18").Copy
Windows("Zieldatei").Activate
Range("X3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("O9:O18").Copy
Windows("Zieldatei").Activate
Range("AB3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Activate
Windows("Quelldatei").Activate
Range("A20").Activate
End If

End Sub

MfG
Daniel

Antwort 16 von coros

Hallo Daniel,

ich vermute mal stark, dass es daran liegt, dass beide Dateien nicht geöffnet sind. Du musst beide Dateien noch vor dem Kopieren der Daten über z.B. die Befehle

Workbooks.OpenText Filename:=Zieldatei
Workbooks.OpenText Filename:=Quelldatei


öffnen.


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 17 von daniel-s

Hallo Oliver,

ne, beide Files sind geöffnet. Kann man den Code anstelle aus einem Modul auch über einen CommandButton starten?

Mfg
Daniel

Antwort 18 von coros

Hallo Daniel,

klar kann man ein Makro auch über eine Schaltfläche starten. Wenn es sich um den CommandButton1 handelt, sieht der Code folgendermaßen aus:

Option Explicit

Private Sub CommandButton1_Click()
Data_Transfer
End Sub


Bei Klick auf CommandButton1 wird das Makro Data_Transfer gestartet.

Zu dem Laufzeitfehler, müsste man Deine Datei und jeweils mal eine Ziel- und Quelldatei haben, um das zu testen. Es kann auch sein, dass der Windowsname anders lautete als der Dateiname. Aber dass alles kann man nur sehen, wenn man die Dateien mal vor sich hat. Alles andere ist mit langen Stangen im Nebel stochern.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 19 von daniel-s

Hallo Oliver,

kurze Präzisierung:

Der Code wird aus der Quelldatei heraus aufgerufen. Es gibt nicht 3 sondern nur 2 Dateien.

Könnte hier der Fehler liegen?

Nochmals Danke.

Gruß
Daniel

Antwort 20 von coros

HAllo Daniel,

nein, dann gibt es therotetisch nur eine Datei und zwar die Zieldatei. Die Quelldatei ist ja bereits geöffnet und deren Name könnte man mit der Zeile

Quelldatei = ThisWorkbook.Name


in eine Variable speichern.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 21 von daniel-s

Hallo Oliver,

wenn ich anstelle der Variable Zieldatei den richtigen Dateinamen in die Zeile schreibe, dann funktioniert es.

Windows("Zieldatei").Activate

Gibt es noch andere Möglichkeiten, eine andere Datei zu öffnen?

Antwort 22 von coros

Hallo Danie,

mit nachfolgendem Makro sollte es eigentlich funktionieren. Kopiere es in ein StandardModul. Bitte lass die Zieldatei geschlossen, die wird durch das Makro geöffnet.

Option Explicit

Sub Data_Transfer()
Dim Quelldatei$, Zieldatei$

Application.ScreenUpdating = False

Quelldatei = ThisWorkbook.Name
Zieldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Zieldatei auswählen...")


If Dir(Zieldatei) = "" Then Exit Sub

If Dir(Zieldatei) <> "" Then
Workbooks.Open Zieldatei
Zieldatei = ActiveWorkbook.Name
Windows(Quelldatei).Activate

Sheets("INTERFACE").Activate
Range("A9:C18").Copy
Windows("Zieldatei").Activate
Sheets("CREW_DATA").Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("E9:L18").Copy
Windows("Zieldatei").Activate
Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("M9:M18").Copy
Windows("Zieldatei").Activate
Range("U3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("N9:N18").Copy
Windows("Zieldatei").Activate
Range("X3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Quelldatei").Activate
Range("O9:O18").Copy
Windows("Zieldatei").Activate
Range("AB3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Activate
Windows("Quelldatei").Activate
Range("A20").Activate
End If

End Sub



Ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 23 von daniel-s

Hallo Oliver,

danke für die Antwort.

Leider tritt der gleiche Fehler auf.

Der Wechsel von der geöffneten Zieldatei in die Quelldatei funktioniert. Der erste Kopiervorgang streikt dann aber mit dem Laufzeitfehler. Kann der Fehler am Netzwerk liegen oder irgendwo in der Zieldatei?

Gruß
Daniel

Antwort 24 von coros

Hallo Daniel,

dann versuche es mal mit nachfolgendem Makro.

Option Explicit

Sub Data_Transfer()
Dim Quelldatei$, Zieldatei$

Application.ScreenUpdating = False

Quelldatei = ThisWorkbook.Name
Zieldatei = Application.GetOpenFilename("Exceldateien (*.xls), *.xls", , "Bitte Zieldatei auswählen...")

If Dir(Zieldatei) = "" Then Exit Sub

If Dir(Zieldatei) <> "" Then
Workbooks.Open Zieldatei
Zieldatei = ActiveWorkbook.Name

Workbooks(Quelldatei).Sheets("INTERFACE").Range("A9:C18").Copy
Workbooks(Zieldatei).Sheets("CREW_DATA").Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(Quelldatei).Range("E9:L18").Copy
Workbooks(Zieldatei).Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(Quelldatei).Range("M9:M18").Copy
Workbooks(Zieldatei).Range("U3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(Quelldatei).Range("N9:N18").Copy
Workbooks(Zieldatei).Range("X3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(Quelldatei).Range("O9:O18").Copy
Workbooks(Zieldatei).Range("AB3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("Quelldatei").Activate
Range("A20").Activate
End If
End Sub


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 25 von daniel-s

Hallo Oliver,

vielen, vielen Dank!!!!!

Die unteren Range Objekte müssen nur noch ausführlich geschrieben werden, dann klappts.

Du bist die Macht!

Besten Dank
Daniel

Antwort 26 von coros

Hallo Daniel,

freut mich, das es funktioniert. Danke auch für die Rückmeldung.

MfG,
Oliver
Jeder macht was er will, keiner macht was er soll, aber alle machen mit.

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: