Das Archiv des Excel-Forums

Inpptbox

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

    Betrifft: Inpptbox
    von: Peppi

    Geschrieben am: 28.09.2003 18:49:03

    Hallo,

    ich bastle seit einiger zeit an einem Archivierungsprogramm für CD´s herum, komme aber wegen meiner kaum vorhandenen Kenntnisse in Sachen Makros nicht weiter.
    Ich möchte eine Inputbox öffnen, um in einer Suche den Suchbegriff abzufragen. Das funktioniert auch so weit. Auswahlmöglichkeit 'OK' und 'Abbrechen'. Nun wollte ich es so einrichten, dass wenn ein Text eingegeben und OK gedrückt wurde, die Suche startet, wenn kein Text eingegeben und OK gedrückt wurde, eine erneute Abfrage kommt und wenn man auf 'Abbrechen' drückt, soll halt ein Fenster mit 'Suche abgebrochen' erscheinen. Das erste nd das letzte funtioniert, aber das mit keinen Text eingeben und ok drücken läuft nicht. Ich habe versucht es über eine If, ElseIf, Else Anweisung zu machen, also Text eingeben und nicht Abbrechen, dann Anweisungen ausführen, ElseIf kein Text eingeben und ok und else 'Abbrechen' gewählt. Wie gesat, das ElseIf funktioniert nicht so wie es soll. Den Text, der eingegeben wird, speichere ich in einem String strSuchtext. die ElseIf Anweisung sieht bei mir im Moment so aus
    'Wenn der Text nicht eingegeben und nicht 'Abbrechen' gewählt wurde...
    ElseIf strSuchtext Is Nothing > "" Then

    Würde mich freuen, wenn sich jemand finden würde, der kapier, was ich hier geschrieben habe und eine Antwort weiß, wie ich die Bedingung aufstellen muss.

    Vielen Dank schonmal
    Gruß

    Peppi
    Bild


    Betrifft: AW: Inpptbox
    von: Nepumuk
    Geschrieben am: 28.09.2003 19:07:09

    Hallo Peppi,
    so geht's:

    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
    


    Code eingefügt mit: Excel Code Jeanie

    Gruß
    Nepumuk


    Bild


    Betrifft: AW: Inpptbox
    von: Peppi
    Geschrieben am: 29.09.2003 21:03:14

    Vielen Dank erstmal für die Antwort, aber irgendwie komme ich damit nicht so richtig klar. Vermutlich sind meine Kenntnisse in der Materie doch ein wenig zu klein, noch.
    Im Moment sieht mein Suchprogramm wie folgt aus:

    
    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
    'Fenster mit "Suche abgebrochen!" öffnen und...
    MsgBox "Suche abgebrochen4!", vbInformation, APP_NAME
    '... Makro beenden
    Exit Sub
    'If 010
    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?", 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
    'Infobox mit"Suche abgebrochen!" öffnen....
    'MsgBox "Suche abgebrochen20!", vbInformation, APP_NAME
    Exit Sub
    ' End If
    End Sub
    



    Ein paar kleine Fehler sind noch drin, aber die bekomme ich denke ich selbst in den Griff. Ich bekomme allerdings das mit der Widerholten Abfrage nach einem Suchbegriff nicht hin, falls keine eingegeben und doch auf Ok geklickt wurde.
    Wie muss ich das folgende mit meiner Sache kombinieren, damit es läuft?

    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
    


    Würde mich freuen, wenn mir da jemand weiter helfen könnte.
    Gruß
    Peppi


     Bild