Inputbox/Schleife

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm InputBox MsgBox
Bild

Betrifft: Inputbox/Schleife
von: Peppi
Geschrieben am: 30.09.2003 20:29:08

Hallo,

ich bastle seit einiger Zeit an einem Programm zur Archivierung von CD´s. Meine Kenntnisse im Programmieren sind eher laienhaft, so dass ich das ein oder andere Problem habe. Im Moment versuche ich eine Suchfunktion zu erstellen. Ich frage die Suchbegriffe mit einer Inputbox ab. Nun möchte ich realisieren, dass wenn kein Suchbegriff eingegeben, aber trotzdem 'OK' gewählt wird ein Fenster mit einer MEldung aufgeht, in dem darauf hingewiesen wird, dass man einen Suchbegriff eingeben soll. Wenn man dies Fenster "bestätigt" soll halt die Inputbox wieder erscheinen, so lange bis ein Suchbegriff eingeben wird und 'OK' gedrückt wird oder bis 'Abbrechen' gewählt wird. Nepumuk hat mir da schon was zu geschreiben wie es geht, doch meine Kenntnisse reichen leider noch nicht aus, um das mit meiner bisherigen Suchfunktion zu kombinieren. Ich unten mal meine bisherige Suchfunktion und darunter die Antwort von Nepumuk, wie es gehen soll gestellt. Würde mich freuen, wenn mir da jemand weiter helfen könnte. Vielen Dank schonmal. Das ganze basiert auf einem Amkro, was einmal in der ct' war. Das will ich nur ein wenig für meine Zwecke erweitern. Auf Wunsch kann ich auch mal das ganze Projekt per mail zusenden.
Gruß
Peppi

Hier meine bisherige Suchfunktion:


Private Sub Suchen()
Dim antwort As Variant
Dim strSuchKatalogblattName As String
    Dim strSuchtext As String
    Dim objBlatt As Worksheet
    Dim objSuchKatalogblatt As Worksheet
    Dim objZelle As Range
    Dim objZeile As Range
    Dim strErsteFundstelle As String
    Dim intButton As Integer
    Dim objForm As UserForm
    
    'Zu suchenden Text abfragen; Vorgabe aus Registry lesen
    strSuchtext = Trim(InputBox("Gesuchter Text:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
    'Wenn Suchtext angegeben und nicht 'Abbrechen' gewählt, dann...
    'If 001
    If strSuchtext > "" Then
        '... Suchtext in Registry speichern
        SaveSetting APP_NAME, "Einstellungen", "Suchtext", strSuchtext
      
           
                    'Prüfen, ob SuchKatalogblatt bereits existiert
                    Set objSuchKatalogblatt = GetWorksheet(strSuchtext)
                    'Wenn SuchKatalogblatt nicht existiert, dann...
                    'If 004
                    If objSuchKatalogblatt Is Nothing Then
                        'Neues Katalogblatt anlegen
                        Set objSuchKatalogblatt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                        'Suchtext bildet Namen des SuchKatalogblattes
                        objSuchKatalogblatt.Name = strSuchtext
                    'If 004
                    Else
                       'Wenn SuchKatalogblatt existiert, dann...
                       'If 005
                       If Not objSuchKatalogblatt Is Nothing Then
                           '...Erlaubnis zum Überschreiben der vorhandenen Daten einholen
                           intButton = MsgBox("Suchkatalogblatt existiert bereits. Vorhandenes Suchkatalogblatt überschreiben?", vbQuestion + vbYesNo, APP_NAME)
                           'Wenn Anwender Erlaubnis gibt, dann...
                           'If 006
                           If intButton <> vbNo Then
                               '...Inhalte im verwendeten Bereich des Suchkatalogblattes löschen
                               objSuchKatalogblatt.UsedRange.ClearContents
                              'Ansonsten.., also, wenn der Anwender keine Erlaubnis zum überschreiben gebeben hat
                           'If 006
                           Else
                               'Wenn der Anwender die Erlaubnis nicht gibt, dann...
                               'If 007
                               If intButton <> vbYes Then
                                   '...fragen, ob ein neues Suchkatalogblatt angelegt werden soll
                                   intButton = MsgBox("Neues Suchkatalogblatt anlegen?", vbQuestion + vbYesNo, APP_NAME)
                                   'End If 007
                                   'End If
                                   'Wenn der Anwender kein neues Katalogblatt anlegen möchte, dann...
                                   'If 008
                                   If intButton <> vbYes Then
                                        '...ein Fenster mit der Meldung "Das existierende Suchkatalogblatt öffnen?"
                                        intButton = MsgBox("Das existierende Suchkatalogblatt öffnen?", vbQuestion + vbYesNo, APP_NAME)
                                        'Wenn die Antwort nicht 'Ja' lautet, also das existierende suchKatalogblatt nicht geöffnet werden soll, dann...
                                        'If 009
                                        If intButton <> vbYes Then
                                            MsgBox "Suche abgebrochen6!", vbInformation, APP_NAME
                                            Exit Sub
                                        'If 009
                                        Else
                                            'Suchkatalogblatt aktivieren
                                            objSuchKatalogblatt.Activate
                                            Exit Sub
                                        'End If 009
                                        End If
                                   
                                'Wenn der Anwender doch ein neues Suchkatalogblatt anlegen möchte, dann...
                                'If 008
                                Else
                                    '...fragen, wie das neue Suchkatalogblatt heißen soll; Vorgabe aus Regitry lesen
                                    strSuchKatalogblattName = Trim(InputBox("Name des neuen Suchkatalogblattes:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "SuchKatalogblattName", "")))
                                    'Wenn der neue SuchKatalogblattName eingegeben worden und nicht 'Abbrechen' gewählt wurde, dann...
                                    'If 011
                                    If strSuchKatalogblattName > "" Then
                                        '... SuchKatalogblattName in Registry speichern
                                        SaveSetting APP_NAME, "Einstellungen", "SuchKatalogblattName", strSuchKatalogblattName
                                        'Ein neues SuchKatalogblatt anlegen
                                        Set objSuchKatalogblatt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                                        'Name des neuen SuchKatalogblattes
                                        objSuchKatalogblatt.Name = strSuchKatalogblattName
                                    'If 011
                                    Else
                                    MsgBox "Suche abgebrochen5!", vbInformation, APP_NAME
                                    Exit Sub
                                    'End If 011
                                    End If
                                'End If 008
                                End If
                              'End If 006
                              End If
                       'End If 005
                       End If
                   'End If 004
                   End If
                         
            'End With
                'End If 001
                End If
                   'End If
                    'ab hier was geändert
                      'Ab hier was eingefügt
    '''''''''
    'SuchKatalogblatt gestalten
    With objSuchKatalogblatt
    'Spaltenformatierungen festlegen
    .Columns(1).ColumnWidth = 10
    .Columns(2).ColumnWidth = 26
    .Columns(3).ColumnWidth = 24
    .Columns(4).ColumnWidth = 7
    .Columns(5).ColumnWidth = 24
    .Columns(6).ColumnWidth = 26
    .Columns("A").NumberFormat = "0000"
    .Columns("B").NumberFormat = "0000"
    .Columns("C").NumberFormat = "00"
    'Zeileninhalte und -formatierungen festlegen
    'Alle Zellinhalte links ausrichten
    .Rows.HorizontalAlignment = xlLeft
    With .Rows(1)
         .Cells(1).Value = "CD-Nummer:"
         .Cells(1).Font.Size = 8
         .Cells(1).Font.Bold = True
    End With
    With .Rows(1)
         .Cells(2).Value = "CD-Seite"
         .Cells(2).Font.Size = 8
         .Cells(2).Font.Bold = True
    End With
    With .Rows(1)
         .Cells(3).Value = "Künstler"
         .Cells(3).Font.Size = 8
         .Cells(3).Font.Bold = True
    End With
    With .Rows(1)
         .Cells(4).Value = "Album"
         .Cells(4).Font.Size = 8
         .Cells(4).Font.Bold = True
    End With
    
       'Alle Blätter durchlaufen
        For Each objBlatt In ActiveWorkbook.Worksheets
            'Verwendeten Bereich jedes Blatts durchsuchen
            With objBlatt.UsedRange
                'Suchfunktion aufrufen
                Set objZelle = .Find(What:=strSuchtext, LookIn:=xlValues) 'Wenn keine Fundstelle existiert
                
                'Wenn erster Treffer, dann...
                'If 003
                If Not objZelle Is Nothing Then
                    '... Fundstelle merken
                    strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
                    Do
                        'Blatt mit Fundstelle aktivieren
                        objBlatt.Activate
                        'Fundstelle markieren
                        objZelle.Select
                        'Anwender fragen, ob Suche fortgesetzt werden soll
                        intButton = MsgBox("Weiter suchen?", vbQuestion + vbYesNo, APP_NAME)
                        'Wenn Antwort nicht 'Ja' lautet, dann...
                        'If 010
                        If intButton <> vbYes Then
                            'Fragen, ob das Suchkatalogblatt geöffnet werden soll
                            intButton = MsgBox("Das Suchkatalogblatt öffnen?22", vbQuestion + vbYesNo, APP_NAME)
                            'Wenn die Antwort nicht 'Ja' lautet, dann...
                            'If 016
                            If intButton <> vbYes Then
                                'Infofenster mit "Suche beendet!" öffnen und...
                                 MsgBox "Suche beendet3!", vbInformation, APP_NAME
                                '...Makro beenden
                                Exit Sub
                            'If 016
                           Else
                            'Suchkatalogblatt aktivieren
                            objSuchKatalogblatt.Activate
                            '... Makro beenden
                            Exit Sub
                        'If 010
                        End If
                        'If 016
                        End If
                        'Nach nächstem Vorkommen suchen
                        Set objZelle = .FindNext(objZelle)
                    'Schleife wiederholen solange weitere Fundstellen auftauchen und erste Fundstelle noch nicht erreicht
                    Loop While Not objZelle Is Nothing And objBlatt.Name & "!" & objZelle.Address <> strErsteFundstelle
                'Else
                'Infobox mit "Keine Fundstellen!" öffnen und....
                'MsgBox "Keine Fundstellen.", vbInformation, APP_NAME
                '...Makro beenden
                'Exit Sub
                'If 003
                End If
            End With
        Next
        MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
        'Fragen, ob das Suchkatalogblatt geöffnet werden soll
        intButton = MsgBox("Das Suchkatalogblatt öffnen?33", vbQuestion + vbYesNo, APP_NAME)
        'Wenn die Antwort nicht 'Ja' lautet, dann...
        'If 015
        If intButton <> vbYes Then
            'Infofenster mit "Suche beendet!" öffnen und...
            MsgBox "Suche beendet3!", vbInformation, APP_NAME
            '...Makro beenden
            Exit Sub
         'If 015
         Else
             'Suchkatalogblatt aktivieren
             objSuchKatalogblatt.Activate
             Exit Sub
         'If 015
         End If
    'If 001
    'End If
    
 End With
 
  '''''
 'End If
 '''
    'strSuchtext = Trim(InputBox("Bitte geben Sie einen Suchtext ein und drücken sie OK, um die Suche zu beginnen oder auf Abbrechen, um die Suche abzubrechen:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
    
       
 
 'Wenn bei der erneuten Abfrage nach einem Suchtext auf 'Abbrechen' gedrückt wird....
 
 'End If
 Else
 'Wenn bei der ersten Suchtextabfrage 'Abbrechen' gewählt wird
 'Infobox mit"Suche abgebrochen!44" öffnen....
 MsgBox "Suche abgebrochen20!", vbInformation, APP_NAME
 Exit Sub
 End If
End Sub




Hier die Antwort von Nepumuk:

Option Explicit
Public Sub test()
Dim antwort As Variant
Do
antwort = Application.InputBox("Bitte Suchbegriff eingeben.", "Eigabe")
If antwort = False Then Exit Do
If Trim(antwort) <> "" Then
Call suchen((antwort))
Exit Do
End If
MsgBox "Gib doch bitte was ein, oder klick auf abbrechen.", 48, "Hinweis"
Loop
End Sub


Private Sub suchen(suchbegriff As String)
'    hier kommt dein Suchprogramm
End Sub

Bild


Betrifft: AW: Inputbox/Schleife noch offen
von: Hajo_Zi
Geschrieben am: 30.09.2003 20:43:46

Hallo Peppi

wer soll sich das ansehen, das st schon eine Menge Code und darum das der Code so breit ist bleibt man nur in ein Scrollen nach Links/rechts um die Aufgabenstellung zu lesen. Versuche es mal selber!!

Nepumuk hat Dir doch schon den richtigen Hinweis gegeben.



Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.

Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.
Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.
Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.
Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.


http://home.media-n.de/ziplies/



Bild


Betrifft: Danke, hat sich erledigt, dumm von mir, Danke!
von: Peppi
Geschrieben am: 30.09.2003 21:17:01

Danke, hat sich erledigt. Man solte vielleicht vorher mal ein wenig besser hin sehen.
Danke nochmals.


 Bild

Beiträge aus den Excel-Beispielen zum Thema " Gitternetzlinien und Achsen formatieren"