Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
880to884
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
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Endlosschleife im Makro, komme nicht raus

Endlosschleife im Makro, komme nicht raus
27.06.2007 09:01:02
Claudia
Hallo guten Morgen alle zusammen,
mit nachstehendem Makro, habe ich mal von Hajo erhalten, kann ich mittels Freischaltcode eine im Registrieungs-Editor gesetzte 30 Tage Demo unbegrenzt freischalten. Das klappt auch super (wenn der Code richtig ist), nur habe ich jetzt versucht, das mann beim freischalten mehrmals den Code eingeben darf, falls man sich vertippt hat. Allerdings ist das jetzt eine Endlosschleife und ich komme nicht mehr aus dem Programm heraus.
Was muss am Ende geändert werden, das das Programm nach z.B. dreimaligen falschen Code sich speichert evtl. ein Hinweis ersheint und sich schließt. Ich hoffe das das verständlich ist.

Private Sub freischalten()
Dim ersterAufruf As Date
If GetSetting("unterlagen", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf") = "" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
ersterAufruf = GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf")
If InputBox("Vielen Dank für Ihre Teilnahme." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Geben Sie bitte den Code ein, den Sie von uns" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "erhalten haben, in das freie Feld ein." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Achten Sie bitte auf Groß- und Kleinschreibung" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Productkey Eingabe des Teilnehmers") = "test" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
MsgBox "Die Eingabe ist nicht richtig." & vbLf _
& "Versuchen Sie es erneut indem Sie den Code  eingeben." & vbLf _
& "Falls Sie Probleme haben, senden Sie uns eine E-Mail."
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then GoTo Fehlerb
End If
Fehlerb:
Application.Run "freischalten"
End Sub


Vielen Dank für Eure Hilfe
Gruß
Claudia

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Endlosschleife im Makro, komme nicht raus
27.06.2007 09:08:00
Tom
Hallo Claudia,
versuch das mal:

Private Sub freischalten()
Dim ersterAufruf As Date
Static byAnzahlAufrufe As Byte
If byAnzahlAufrufe = 2 Then
MsgBox "Anzahl der Versuche überschritten.", vbExclamation, "Mein Titel"
Exit Sub
End If
If GetSetting("unterlagen", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf") = "" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
ersterAufruf = GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf")
If InputBox("Vielen Dank für Ihre Teilnahme." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Geben Sie bitte den Code ein, den Sie von uns" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "erhalten haben, in das freie Feld ein." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Achten Sie bitte auf Groß- und Kleinschreibung" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Productkey Eingabe des Teilnehmers") = "test" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
MsgBox "Die Eingabe ist nicht richtig." & vbLf _
& "Versuchen Sie es erneut indem Sie den Code  eingeben." & vbLf _
& "Falls Sie Probleme haben, senden Sie uns eine E-Mail."
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then GoTo Fehlerb
byAnzahlAufrufe = byAnzahlAufrufe + 1
End If
Fehlerb:
Application.Run "freischalten"
End Sub


Anzeige
AW: Endlosschleife im Makro, komme nicht raus
Hajo_Zi
Hallo Claudia,

Option Explicit
Private Sub freischalten()
Dim ersterAufruf As Date
Dim ByI As Byte
If GetSetting("unterlagen", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf") = "" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
ersterAufruf = GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf")
'    ersterAufruf = CDate("23.12.1972")
Do
If InputBox("Vielen Dank für Ihre Teilnahme." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Geben Sie bitte den Code ein, den Sie von uns" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "erhalten haben, in das freie Feld ein." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Achten Sie bitte auf Groß- und Kleinschreibung" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Productkey Eingabe des Teilnehmers") = "test" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
MsgBox "Die Eingabe ist nicht richtig." & vbLf _
& "Versuchen Sie es erneut indem Sie den Code  eingeben." & vbLf _
& "Falls Sie Probleme haben, senden Sie uns eine E-Mail."
ThisWorkbook.Saved = True
ByI = ByI + 1
If Workbooks.Count = 1 Then GoTo Fehlerb
End If
Loop Until ByI = 3
Fehlerb:
Application.Run "freischalten"
End Sub



Anzeige
AW: Endlosschleife im Makro, komme nicht raus
27.06.2007 09:27:00
Claudia
Hallo Tom, hallo Hajo,
danke für Eure Hilfe. Das von Tom funzt super gut und läuft. Habe wieder dazugelernt.
Gruß
Claudia

Einer MsgBox kann man bis zu 3...
27.06.2007 09:16:31
Luc:-?
...verschiedene Antworten geben, Claudia,
die man auch abfragen kann (z.B. Ja/Nein/Abbruch). Das würde das Ganze etwas komfortabler gestalten! Außerdem ist das ja wohl eine äußerst merkwürdige Fehlerbehandlung die ganz ohne Fehler auskommt! Die entsprechende Zeile, d.h. der PgmSelbstaufruf wird immer erreicht, weil du keine Alternative vorgesehen hast (z.B. Exit Sub). Das Ganze ist wohl schlecht durchdacht und anscheinend bar jeder Pgmablaufkenntnis "verbessert" worden (Editorhilfe benutzen!).
Gruß Luc :-?
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige