Office: (Office 2003) einfache suche via userform wie im browser

Seid gegrüßt!
Da der 'Suchen und Ersetzen' Dialog sehr viel Platz wegnimmt, und von mir häufig genutzte Optionen tief versteckt sind, versuche ich eine kleine Userform mit diesen Optionen zu schreiben die handlicher ist, ähnlich der dünnen Suchleiste im Browser.
Die einzelnen Optionen scheinen zu stimmen, werden auch im Hauptdialog übernommen, nur nach dem Inhalt des eigenlichem Suchffeldes scheint nicht gesucht zu werden noch wird es übernommen.
Auch wird mit compile error: invalid qualifier auf SearchField in der Zeile [.Text = SearchField.value] hingewiesen obwohl ich per Dim dies deklarierte.
Bin für jede Hilfe dankbar.
Der Code hier, im Anhang die ganze Userform als zip

Code:

Private Sub MatchCase_Click()
    With Selection.Find: .MatchCase = Not .MatchCase: End With
End Sub
Private Sub HighlightAll_Click()
    With Selection.Find: .Highlight = Not .Highlight: End With
End Sub
Private Sub UseWildcards_Click()
    With Selection.Find: .MatchWildcards = Not .MatchWildcards: End With
End Sub
Private Sub WholeWords_Click()
    With Selection.Find: .MatchWholeWord = Not .MatchWholeWord: End With
End Sub

Private Sub FormatBold_Click()
    With Selection.Find: .Font.Bold = wdToggle: End With
End Sub
Private Sub FormatItalic_Click()
    With Selection.Find: .Font.Italic = wdToggle: End With
End Sub
Private Sub FormatStrike_Click()
    With Selection.Find: .Font.StrikeThrough = wdToggle: End With
End Sub
Private Sub FormatUnderline_Click()
    With Selection.Find
        If .Font.Underline = wdUnderlineNone Then
            .Font.Underline = wdUnderlineSingle
        Else
            .Font.Underline = wdUnderlineNone
        End If
    End With
End Sub

Private Sub SearchField_Change()
   If InStr(SearchField.Text, " ") Then
       SearchField.value = False
   End If
End Sub

Private Sub Up_Click()
    Dim Rng As Range: Set Rng = ActiveDocument.Range
    Call SearchCode
    With Rng.Find: .Forward = False: .Wrap = wdFindStop: End With: Selection.Find.Execute
End Sub
Private Sub Down_Click()
    Dim Rng As Range: Set Rng = ActiveDocument.Range
    Call SearchCode
    With Rng.Find: .Forward = True: .Wrap = wdFindStop: End With: Selection.Find.Execute
End Sub

Private Sub SearchCode()
    Dim Rng As Range: Set Rng = ActiveDocument.Range
    Dim SearchField As String
    Options.DefaultHighlightColorIndex = wdYellow
    If Len(Selection) > 0 Then Set Rng = Selection.Range
    With Rng.Find
        If Len(Selection) = 0 Then Exit Sub
         .ClearFormatting
   ' check options
        .MatchCase = MatchCase.value
        .MatchWildcards = UseWildcards.value
        .Highlight = HighlightAll.value
        .MatchWholeWord = WholeWords.value
    ' check formats
        .Font.Bold = FormatBold.value
        .Font.Italic = FormatItalic.value
        .Font.Underline = FormatUnderline.value
        .Font.StrikeThrough = FormatStrike.value
    ' search input
        .Text = SearchField.value
    ' find
        .Replacement.Highlight = True
        .Format = False
    End With
End Sub

 

Vielleicht solltest Du ganz unten nicht SearchField.value, sondern SearchField.text nehmen?
Gruß
Burkhard

 

Hallo Buggy,

"den einen" Fehler, warum der Code nichts findet, hab ich nicht entdeckt. Aber ich hab so viele Fragen zu diesem Code, dass ich ihn einfach mal so umgestaltet habe, wie ich denke, dass du ihn haben wolltest (siehe unten).

Meine wichtigsten Fragen:

• ich bin nicht ganz schlau daraus geworden, ob du nun das komplette Dokument durchsuchen willst, oder nur eine vorher gesetzte Auswahl. Du wechselst sehr oft zwischen Selection.Range und ActiveDocument.Range.
• Zudem finde ich es unübersichtlich, mit den Ereignissen Up_Click und Down_Click die Hauptroutine SearchCode zu starten, aber die eigentliche Suche dann doch wieder erst in den Ereignis-Routinen stattfinden zu lassen. Ich fände es übersichtlicher, die Suche auch in der Suchroutine vorzunehmen.
• Ich versteh auch nicht, warum du die Werte der Checkboxen in der Userform per Subroutinen aufrufen musst. Du kannst sie doch direkt auslesen. Bei der Gelegenhheit: Der Parameter find.HighlightAll ist mir unbekannt. Ich hab ihn durch find.Highligt ersetzt, in der Annahme, dass du damit gemarkerten Text finden wolltest.
• Den Sinn der Sub Searchfield_Change() versteh ich nicht: Wenn ich den Code übersetze lautet der: Prüfe bei jedem Tastenschlag: Wenn der Inhalt der Textbox ein Leerzeichen enthält, setze den Inhalt der Textbox auf false. Was willst du denn damit prüfen? Ich hab das mal rausgelassen
• In der Hauptroutine selbst ist mir aufgefallen, dass du "Searchfield" als String deklariert hast. Das ist doch der Name des Suchfensters in der Userform!
• Außerdem nehm ich mal an, dass die Option .format auf True gesetzt werden muss, da du doch explizit (auch) nach formatiertem Text suchen willst.

Hier nun der umgestrickter Code: Er durchsucht den markierten Bereich bzw. das ganze Dokument, markiert die erste Fundstelle und bricht dann ab. Ich annehme an, dass er das soll. Wenn nicht, melde dich. Alle Einzelheiten hab ich aber noch nicht durchgecheckt. Nicht verkehrt wäre auch eine Meldung, falls der Suchbegriff nicht gefunden wird. Aktuell wird dann das komplette Dokument markiert.

Code:

Private Sub Up_Click()
 Call SearchCode
End Sub
 
Private Sub Down_Click()
 Call SearchCode
End Sub

Private Sub SearchCode()
Dim Rng As Range

Options.DefaultHighlightColorIndex = wdYellow
 
        If Len(Selection) > 1 Then
            Set Rng = Selection.Range
        Else
            Set Rng = ActiveDocument.Range
        End If
   
    With Rng.Find
        .ClearFormatting
   
        ' check options
        .Format = True
        .MatchCase = MatchCase.Value
        .MatchWildcards = UseWildcards.Value
        .Highlight = HighlightAll.Value
        .MatchWholeWord = WholeWords.Value
 
        ' check formats
        .Font.Bold = FormatBold.Value
        .Font.Italic = FormatItalic.Value
        .Font.Underline = FormatUnderline.Value
        .Font.StrikeThrough = FormatStrike.Value
 
        ' search input
        .Text = SearchField.Text
 
        ' find
        .Execute findtext:=SearchField.Text
        .Parent.Select
    End With

FindBar.hide
End Sub

Gruß
Gerhard

 

Danke euch Beiden habe ich die vorwärts und rückwärts Suche zusammengebastelt. Nun sucht die UF in beide Richtungen.
Danke Gerhard H für die vielen Anregungen, da hatte ich wirklich zu viel unnötigen Code. Die Subroutinen für die Checkboxen waren gedacht um die Optionen in den F&R mit zu übergeben, ist aber nun redundant. Während der Code Bastellei war's hilfreich, um zu sehen, daß die Optionen funktionerten als die Suche noch nicht klappte – da die UF die Suche nicht speichert.

Was noch nicht / nicht richtig funktionert sind die Optionen Wildcards (nicht richtig: nur erste und letzte Instanz gefunden) & Highlight (gar nicht)

Code:

Private Sub Up_Click()
    Dim Rng As Range
    Options.DefaultHighlightColorIndex = wdYellow
        If Len(Selection) > 1 Then
            Set Rng = Selection.Range
        Else
            Set Rng = ActiveDocument.Range
        End If
    With Rng.Find
    ' delete previous options and formats
        .MatchCase = False
        .Highlight = False
        .MatchWildcards = False
        .MatchWholeWord = False
        .ClearFormatting
    ' check options
        .Format = True
        .MatchCase = MatchCase.value
        .MatchWildcards = UseWildcards.value
        .Highlight = HighlightAll.value
        .MatchWholeWord = WholeWords.value
    ' check formats
        .Font.Bold = FormatBold.value
        .Font.Italic = FormatItalic.value
        .Font.Underline = FormatUnderline.value
        .Font.StrikeThrough = FormatStrike.value
    ' search input
        .Text = SearchField.Text
    ' find backwards
        .Forward = False
        .Wrap = wdFindContinue              ' wdFindStop: ends search upon reaching doc beginning/end, wdFindContinue cycles doc eternally
        .Execute FindText:=SearchField.Text
        .Parent.Select
    End With
End Sub
Private Sub Down_Click()
    Dim Rng As Range
    Options.DefaultHighlightColorIndex = wdYellow
        If Len(Selection) > 1 Then
            Set Rng = Selection.Range
        Else
            Set Rng = ActiveDocument.Range
        End If
    With Rng.Find
    ' delete previous options and formats
        .MatchCase = False
        .Highlight = False
        .MatchWildcards = False
        .MatchWholeWord = False
        .ClearFormatting
    ' check options
        .Format = True
        .MatchCase = MatchCase.value
        .MatchWildcards = UseWildcards.value
        .Highlight = HighlightAll.value
        .MatchWholeWord = WholeWords.value
    ' check formats
        .Font.Bold = FormatBold.value
        .Font.Italic = FormatItalic.value
        .Font.Underline = FormatUnderline.value
        .Font.StrikeThrough = FormatStrike.value
    ' search input
        .Text = SearchField.Text
    ' find forward
        .Forward = True
        .Wrap = wdFindContinue 'Stop
        .Execute FindText:=SearchField.Text
        .Parent.Select
    End With
End Sub

Zur UF noch einiges Kurioses das wünschenswert wäre zum Optimieren, auch wenn prinzipiell die Funktionalität schon das ist was ich brauch. Anders als mit dem F&R Dialog:
- sind die Format Optionen entweder-oder statt alle Instantzen die auch diese Optinon(en) zusätzlich haben:
--Suchen ohne spezfisch Optionen (Bold/Italic/..) findet auch nur not-Bold/not-Italic/..
--Das gleiche bei mehreren geichzeitig angewanten Optionen, z.B. Bold+Italic Suche findet nur Bold+Italic nicht Bold+Italic+Underline.
- Die Suche beginnt am Dokumentbeginn nicht wo der Kursor ist.
- SuchFeld und Optionen "speichern" nicht die Eingabe; d.h. die UF muss präsent bleiben (kein .hide). Sonst muss neue Suche wieder am Dokumentbeginn starten...
​

 

Hallo Buggy,

ich fang mal mit den einfachen Sachen an:

Wenn du nach Beendigung einer Suche weiterarbeiten möchtest, ohne die Userform schließen zu müssen, kannst du sie modal öffnen (z.B. per Code in ThisDocument):
Sub aufruf()
findbar.Show vbmodeless
End sub

Wenn du möchtest, dass die Suche an der Cursorposition beginnt und bis zum Dokumentende bzw. Dokumentanfang läuft, müsstest du die entsprechenden Codeteile so modifizieren:
Für die Vorwärtssuche:
'Ab Cursorposition bzw. Markierungsanfang bis Dokumentende
Set Rng = Nothing 'vermutlich entbehrlich
Set Rng = ActiveDocument.Range(Selection.Start, ActiveDocument.Range.End)
Für die Rückwärtssuche:
'Ab Cursorposition bzw. Markierungsende bis Dokumentanfang
Set Rng = Nothing 'vermutlich entbehrlich
Set Rng = ActiveDocument.Range(ActiveDocument.Range.Start, Selection.End)
Die If-Verzweigung ist dann entbehrlich, weil die Selection mindestens 1 sein muss bei blinkender Schreibmarke oder größer.

Die Sache mit der Weitersuche nach dem ersten Treffer wird wohl nicht so einfach, wie du es codiert hast. Da muss man wohl entweder jeweils den Suchrange neu definieren (z.B. ab Treffer-Ende bis Dokumentende bzw. -anfang). Oder einfach - bei modeless geöffneter Userform - hinter den ersten Treffer klicken und die gleiche Suche fortsetzen.
Ungeklärt ist für mich noch, was passieren soll, wenn der Suchbegriff nicht gefunden wird, oder keiner eingetragen wurde. Da sollte eine Meldung hin, sonst ist man verwirrt.

Die andere Geschichte mit der Kombination von Formatierungsoptionen muss ich mir erst in Ruhe ansehen. Vielleicht kannst du mal ein Beispieldokument machen, was du mit Suchen ohne spezfisch Optionen (Bold/Italic/..) findet auch nur not-Bold/not-Italic/.. meinst, bzw. was da der Mangel ist. Im Moment tendiere ich aber dazu, dass man alle Kombinationen einzeln prüfen muss (also z.B. Bold und Underline: wenn FormatBold wahr ist und FormatUnderline wahr ist, dann suche Textstellen, die fett und unterstrichen sind). Das wird je nach Anzahl und Inhalt der gewünschten Kombinationen ein bisschen aufwändiger.

 

#1
vbmodeless! Danke

#2
Ohne If-Verzweigung bleibt "Set Rng = ActiveDocument.Range(Selection.Start, ActiveDocument.Range.End)" allein nach dem ersten Treffer stecken

In der If-Verzweigung funktionierts, sucht vor-/rückwärts ab cursor

Code:

        If Len(Selection) > 1 Then
            Set Rng = Selection.Range
        Else
            Set Rng = ActiveDocument.Range(Selection.Start, ActiveDocument.Range.End)
        End If

#3
Für die inklusive Format Optionen müßte bei jedem der 4, vermutlich ein Konstrukt der folgenden Struktur sein

Code:

If      FormatBold.value = True    Then   
    .Font.Bold
    .Font.Bold .Font.Italic
    .Font.Bold .Font.Italic + .Font.Underline
    .Font.Bold .Font.Italic + .Font.StrikeThrough
    .Font.Bold .Font.Underline
    .Font.Bold .Font.Underline + .Font.StrikeThrough
    .Font.Bold .Font.StrikeThrough
End If

Nur wie das zu implementieren ist, weiß ich (noch) nicht. Elseif? And/Or?

 

#2b
Für nix gefunden hab ich einen kurzer popup msgbox "nothing found"

Code:

   ' Nothing Found Temp Message
        If .Execute Then
        Else
            CreateObject("WScript.Shell").Popup "Nothing Found", 1, "Sorry"  ' # in seconds
        End If

vor End With
Ideal wäre es, wenn nicht das Document alles markiert

 

Hallo nochmal,

willst du nun jeweils alle möglichen Kombinationen im Zusammenhang mit einer bestimmten Schriftauszeichnung finden oder immer nur bestimmte?
Zweiteres geht meiner Meinung nach nicht oder es wird ein uferloses Geschäft. Dass ersters gehen muss, zeigt die Suche per Dialogfeld. Der Witz ist da, dass man nur eine bestimmte Schriftauszeichnung angibt. Die anderen werden nicht geprüft, und somit findet man z.B. bei Bold auch Bold mit Underline, Bold mit StrikeOut usw.

Dein Code arbeitet da anders, denn wenn z.B. Bold angeklickt ist, sind die anderen Kombinationen auf False gesetzt und werden somit in die Suche nicht mit einbezogen.

Meine einzige Idee ist momentan, reumütig zu deinen Checkbox_Click-Ereignissen zurückkehren, weil man dadurch einfach den Status der angeklickten Checkbox feststellen kann, ohne irgendwas über die Kombinationen sagen zu müssen. Das Suchmakro selbst kann man auslagern.

Ich überlasse dir zur Prüfung ein Fragment, welches aktuell ohne Auswahl eines Suchbereichs (immer das ganze Dokument) und ohne Auswahl der Suchrichtung (Pfeilchen sind außer Gefecht) kommt. Und es funktioniert aktuell auch nur mit fett und kursiv und unterstrichen.

Die Userform wird im Modul ThisDocument aufgerufen; dann kannst du nach "massa" suchen, welche in vielerlei Schriftaufzeichnungen erscheinen. Das Setzen eines Haken bei Bold, Italic oder Underline setzt das Makro in Aktion. Dann guck mal, ob dir die Richtung passt.

Hier die Makros (sind im Dokument enthalten)

Code:

Dim stil As String '**muss über allen Prozeduren deklariert werden, damit alle es finden
Private Sub FormatBold_Click()
'für font.bold
    If FormatBold.Value Then
        stil = ".font." & FormatBold.Caption
        Call such(stil)
   End If
End Sub

Private Sub FormatItalic_Click()
    'für font.italic
    If FormatItalic.Value Then
        stil = ".font." & FormatItalic.Caption
        Call such(stil)
   End If
End Sub

Private Sub FormatUnderline_Click()
    'für font.underline
    If FormatItalic.Value Then
        stil = ".font." & FormatUnderline.Caption
        Call such(stil)
   End If
End Sub

Sub such(stil As String)
'ausgelagertes Suchmodul
If SearchField.Text = "" Then
    MsgBox "Bitte einen Suchtext eingeben!"
    Exit Sub
End If

With ActiveDocument.Range.Find
    .Text = SearchField.Text
    stil = True
    .Replacement.Text = "^&"
    .Replacement.Font.ColorIndex = wdBlue
    .Execute Replace:=wdReplaceAll
        If .Found = False Then
            MsgBox "Kein Treffer"
        End If
End With
End Sub