PDA

Vollständige Version anzeigen : Suchfunktion für Textfelder VBA (Textfeldsuche)


Falke89
01.07.2015, 16:05
Hallo zusammen,


Ich bin neu hier und hoffe Ihr könnt mir helfen, ich verwende derzeit Microsoft Excel 2010.


Zum Problem:

Ich habe ein Arbeitsblatt erstellt, welches eine Baumstruktur mit etlichen Textfeldern (ähnlich folgendem Link) beinhaltet.

http://www.cil.rwth-aachen.de/wp-content/uploads/Bild1.jpg


Da es mittlerweile etwas unübersichtlich wird, möchte ich eine Suchfunktion, mit der ich die Inhalte der Textfelder durchsuchen kann, bei einem Treffer zu dem entsprechenden Textfeld gesprungen wird und sich die Hintergrundfarbe des Textfeldes ändert.


Ich habe auf folgender Seite bereits etwas passendes gefunden:

http://www.excelbeispiele.de/Datei_067.htm

Ich habe mir die Beispieldatei heruntergeladen, etwas rumgespielt, allerdings gibt es noch Probleme bei der Ausführung.

Wenn ich nur beim Beispiel ein 5. Textfeld hinzufüge und die Suche aktiviere, wird das hinzugefügte Textfeld ignoriert!?

Was muss ich machen, damit ich die Suchfunktion verwenden kann???


Vorab schon mal vielen Dank für eure Unterstützung!!!


Gruß

Manuel

aloys78
01.07.2015, 16:21
Hallo Manuel,

es wäre fair gegenüber den Helfern hier im Forum, wenn Du auch einen Link zu dem anderen Forum hier einstellen würdest.

Gruß
Aloys

Hajo_Zi
01.07.2015, 16:21
<a href="http://hajo-excel.de/crossposting.htm" title="Crossposting" >Zu Crossposting lies diese Seite Hajo-Excel.de</a>
Du hast Glück das JINX nicht mehr da ist, ansonsten würde Dein Beitrag wegen Crossposting geschlossen werden.
Ein Zitat aus der Netiquette (hier im Forum):
Unerwünscht sind auch Crosspostings - also dieselbe Frage gleichzeitig in mehreren Foren (nicht nur im MSOF).
Denn auf diese Weise werden mehrere Gruppen von Leuten mit dem gleichen Thema befasst, ohne dass sie voneinander wissen.
Naturgemäß laufen dann die Antworten, die im einen Forum "zu spät" gegeben wurden, ins Leere und bleiben ohne Resonanz.
Es reicht also, zunächst in einem Forum zu posten - wenn die Antworten dann unbefriedigend sein sollten, steht es einem anschließend immer noch offen, ein anderes Forum zu Rate zu ziehen.
Ich mache keine Werbung für andere Foren und verzichte darum auf den Link.
Die Forumssoftware verhindert das auch bei den meisten Foren.

Falke89
02.07.2015, 06:55
Hallo aloys78 und Hajo_Zi,

entschuldigt bitte das Mehrfachposting.
Von der Seite habe ich das noch gar nicht betrachtet, ich werde den Post in den anderen Foren löschen und erst später ein anderes Forum aufsuchen, falls bis dahin keine Lösung gefunden wurde.

Ich hatte nur gedacht, so schneller an eine Lösung zu kommen, ist aber verständlicherweise den Helfern gegenüber unfair.

Wie gesagt ich werde den Post in den anderen Foren löschen und hoffe ihr könnt mir weiterhelfen.

Danke und nochmals sorry :)

Gruß
Manuel

Falke89
02.07.2015, 07:11
Hallo nochmal,

ich hätte jetzt versucht, die anderen Posts zu löschen, aber entweder finde ich keine Löschfunktion oder aber ich habe keine Berechtigung!?

Daher poste ich hier die Links zu den anderen Foren:

http://www.office-fragen.de/index.php?topic=30993.msg33923#msg33923

http://www.vba-forum.de/Forum/View.aspx?ziel=22177-Suchfunktion_für_Textfelder_VBA_(Textfeldsuche)


Gruß
Manuel

Beverly
02.07.2015, 09:07
Hi Manuel,

welche Art Textfelder benutzt du?

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 09:20
Hi Beverly,

bisher verwende ich normale Rechtecke aus dem Reiter Illustrationen -> Formen, da anfangs keine Anforderungen an meine Arbeitsmappe bestanden.

Ich hatte aber auch schon die Befürchtung, dass evtl. das der Grund ist warum es nicht funktioniert :(


Gruß
Manuel

Beverly
02.07.2015, 09:33
Hi Manuel,

also Rechtecke und keine Textfelder? ;)

Sub Suche()
Dim shaShape As Shape
For Each shaShape In ActiveSheet.Shapes
If shaShape.DrawingObject.Text Like "*Alle*" Then '<== Suchbegriff anpassen
shaShape.Select
Exit For
End If
Next shaShape
End Sub


<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 09:57
Hi Beverly,

vielen Dank für deine schnelle Hilfe.
Bei mir kommt aber die Fehlermeldung "Laufzeitfehler '438': Objekt unterstützt diese Eigenschaft oder Methode nicht."


Ich hätte mir das ganze so wie im folgenden Code gedacht, allerdings springen darauf derzeit meine Rechtecke noch nicht an.
Ein zweiter störender Punkt am folgenden Code ist, dass dadurch eine zuvor definierte Hintergrundfarbe gelöscht wird.

Hier der Code:

Option Explicit

Public Textfeld As TextBox

Sub In_Textfeldern_suchen_Hintergundfarbe()
'Variablen deklarieren
Dim Suchbegriff As Variant, Textfeldtext As String

'Eingabefenster auf dem Bildschirm anzeigen und den eingegebenen Text in
'Variable "Suchbegriff" schreiben
Suchbegriff = InputBox("Bitte einen Suchbegriff eingeben.", "Suchbegriff...")

'Wenn die Variable "Suchbegriff" den Wert "False" hat, der entseht hier durch das betätigen der Abbruchtaste,
'oder keinen Wer enthält, das entsteht hier, wenn nichts eingegeben wird, aber dennoch die OK-Taste betätigt wqird,
'dann Prozedur beenden
If Suchbegriff = False Or Suchbegriff = Empty Then Exit Sub

'For Each-Schleife zum Ansprechen aller in dem Tabellenblatt eingesetzten Textfelder anzusprechen
For Each Textfeld In ActiveSheet.TextBoxes

'Das Textfeld, das durch die Schleife angesprochen wird, markieren
ActiveSheet.Shapes(Textfeld.Index).Select

'Bei einem Laufzeitfehler bei der nächsten Befehlszeile weitermachen
On Error Resume Next

'Bei dem markierten Textfeld die Hintergrundfarbe zurücksetzen
Selection.ShapeRange.Fill.Visible = msoFalse

'Den Text aus dem TExtfeld auslesen und in Variable "Textfeldtext" schreiben
Textfeldtext = Selection.Characters.Text

'Wenn der Suchbegriff in dem Textfeld vorkommt (hier über die Funktion "InStr" realisiert,
'ab dem ersten Buchstaben den Text mit dem Suchbegriff vergleicht)
If InStr(1, Textfeldtext, Suchbegriff, 1) Then

'Bildschirmmeldung, in der die Textboxnummer angezeigt wird, ausgeben
MsgBox "Suchbegriff in " & ActiveSheet.Shapes(Textfeld.Index).Name & " gefunden."

'Hintergrundfarbe in rot ändern
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
End If
Next
End Sub

Beverly
02.07.2015, 10:18
Hi,

bei mir kommt kein Fehler - sonst hätte ich dazugeschrieben, dass ich den Code nicht getestet habe. Lade deine Mappe hoch.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 10:54
Hi,

anbei die Map.

Danke!


Gruß
Manuel

Falke89
02.07.2015, 10:56
Jetzt auch ohne Schreibschutz :D

Beverly
02.07.2015, 11:28
Hi Manuel,

du benutzt auch andere Objekte, nicht nur Textfelder und diese kann man nicht über .Text ansprechen. Versuche es so:

Sub Suche()
Dim shaShape As Shape
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*Alle*" Then '<== Suchbegriff anpassen
shaShape.Select
Exit For
End If
ElseIf shaShape.Type = 1 Or shaShape.Type = 6 Or shaShape.Type = 8 Then
If shaShape.Name Like "*Alle*" Then '<== Suchbegriff anpassen
shaShape.Select
Exit For
End If
End If
Next shaShape
End Sub


<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 11:47
Hi Beverly,

vielen Dank für deine Mühe.

Aber da muss ich den Suchbegriff ja dann immer über den Code eingeben!?

Ich bräuchte (leider) schon so eine Funktion ähnlich zu folgendem Beispiel, wo sich ein Fenster öffnet und man dort den Suchbegriff eingeben kann.

Die Beispiel-Datei hänge ich dran.

Beverly
02.07.2015, 12:20
Hi Manuel,

eine Suchabfrage einzubauen ist doch kein Problem:

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage <> "Falsch" And varFrage <> False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
shaShape.Select
Exit For
End If
ElseIf shaShape.Type = 1 Or shaShape.Type = 8 Then
If shaShape.Name Like "*" & varFrage & "*" Then
shaShape.Select
Exit For
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
shaShape.GroupItems(lngZaehler).Select
Exit For
End If
End If
Next lngZaehler
End If
Next shaShape
End If
End Sub


Da du außerdem einige Gruppierungen verwendest, müssen dort auch die Einzelobjekte durchsucht werden - ist im Code ergänzt.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 12:57
Vielen Dank für deine tolle Unterstützung, das funktioniert schon mal super.

Jetzt hätte ich aber noch ein paar Wünsche, falls das möglich wäre ;)

Und zwar habe ich beispielsweise die Bezeichnung Gewinde mehrfach in meiner Mappe.
Daher wäre es toll, wenn alle Formen, welche bspw. "Gewinde" enthalten, der Reihe nach markiert (Schriftfarbe rot und Formkontur rot) werden und zusätzlich zu diesen gescrollt wird.

So wie es im folgenden Code (irgendwie) gelöst wurde:

Option Explicit

Sub In_Textfeldern_suchen_Scrollen()
'Variablen deklarieren
Dim Textfeld As TextBox, Suchbegriff As Variant, Textfeldtext As String, Abfrage As Variant

'Wenn die Variable "Suchbegriff" den Wert "False" hat, der entseht hier durch das betätigen der Abbruchtaste,
'oder keinen Wer enthält, das entsteht hier, wenn nichts eingegeben wird, aber dennoch die OK-Taste betätigt wqird,
'dann Prozedur beenden
Suchbegriff = InputBox("Bitte einen Suchbegriff eingeben.", "Suchbegriff...")

'Wenn Keine Eingabe erfolgte oder die Abbrechentaste betätigt wurde, Prozedur beenden
If Suchbegriff = False Or Suchbegriff = Empty Then Exit Sub

'For Each-Schleife zum Ansprechen aller in dem Tabellenblatt eingesetzten Textfelder anzusprechen
For Each Textfeld In ActiveSheet.TextBoxes

'Das Textfeld, das durch die Schleife angesprochen wird, markieren
ActiveSheet.Shapes(Textfeld.Index).Select

'Bei dem markierten Textfeld die Schriftfarbe zurücksetzen
Selection.Font.ColorIndex = 0

'Den Text aus dem TExtfeld auslesen und in Variable "Textfeldtext" schreiben
Textfeldtext = Selection.Characters.Text

'Wenn der Suchbegriff in dem Textfeld vorkommt (hier über die Funktion "InStr" realisiert,
'ab dem ersten Buchstaben den Text mit dem Suchbegriff vergleicht)
If InStr(1, Textfeldtext, Suchbegriff, 1) Then

'Zum Textfeld das die Übereinstimmung enthält scrollen
ActiveWindow.ScrollIntoView _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0

'Hintergrundfarbe in rot ändern
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.Visible = msoTrue

'Die Farbe der Buchstaben des gefundenen Suchbegriffs ändern
Selection.Characters( _
Start:=InStr(1, Textfeldtext, Suchbegriff, 1), _
Length:=Len(Suchbegriff)).Font.ColorIndex = 3

'Bildschirmmeldung, in der die Textboxnummer angezeigt wird, ausgeben
MsgBox "Suchbegriff in " & ActiveSheet.Shapes(Textfeld.Index).Name & " gefunden."
End If
Next
End Sub

Beverly
02.07.2015, 13:36
Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage <> "Falsch" And varFrage <> False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
End Sub



Einen Teil des Codes habe ich entfernt da ich festgeestellt habe, dass er die Schalter ganz oben links betrifft, die ja nicht verändert werden sollen.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 13:48
Vielen vielen Dank Beverly, das ist zu 100% genau das was ich brauche.

Könntest du mir bitte noch eine Ergänzung schicken, dass die Formatierung zum Schluss bzw. bei einer neuen Suche wieder verschwindet.
(Sonst ist bei mehreren Suchanfragen irgendwann alles rot :grins: )


Nach deiner super Leistung denke ich, dass das auch kein Problem mehr ist. :boah:


Vielen Dank nochmal.


Gruß
Manuel

Beverly
02.07.2015, 14:19
Hi Manuel,

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
Dim arrShapes()
Dim lngShapes As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage <> "Falsch" And varFrage <> False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 1, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.Name
arrShapes(1, lngShapes) = shaShape.DrawingObject.Font.Color
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 1, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.GroupItems(lngZaehler).Name
arrShapes(1, lngShapes) = shaShape.GroupItems(lngZaehler).DrawingObject.Font.Color
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
For lngZaehler = 0 To UBound(arrShapes(), 2)
With ActiveSheet.Shapes(arrShapes(0, lngZaehler))
.Line.Visible = msoFalse
.DrawingObject.Font.Color = arrShapes(1, lngZaehler)
End With
Next lngZaehler
End Sub

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
02.07.2015, 14:45
Hi Beverly,

da sehe ich jetzt leider keinen Unterschied, bei mehrfacher Suche wird dann immer mehr rot.

Evtl. könnte man das einfacher mit einem 2. Button machen, bspw. "Suchergebniss zurücksetzen"!?

Es sollen dann also alle Formkonturen wieder verschwinden und die Schrift bei den schwarzen Feldern wieder weiß und die restlichen schwarz werden. :)

Falke89
02.07.2015, 14:51
Ich hätte da an sowas gedacht:

Sub Suchergebnis_zurücksetzen()
'
' Suchergebnis_zurücksetzen Makro
'

'
ActiveSheet.Shapes.Range(Array("TextBox 12")).Select
With Selection.ShapeRange.Line
.Visible = msoFalse
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Range("A1").Select
End Sub

Allerdings habe ich damit jetzt nur eine TextBox angesprochen :p

Beverly
02.07.2015, 17:47
Hi,

der Code macht folgendes: zuerst werden alle Elemente gesucht und die Rahmen sowie der betreffende Texteil rot gefärbt. Gleichzeitig wird der Name des betreffenden Elementes sowie seine Schriftfarbe in ein Array geschrieben. Am Ende des Codes wird das Array in einer Schleife durchlaufen und alle Elemente, die ins Array eigentragen wurden, wieder zurückgesetzt in den Urzustand. Die Schriftfarbe kann nicht einfach auf Schwarz (bzw. automatisch) gesetzt werden, weil es auch Elemente gibt, deren Schriftfarbe Weiß ist - deshalb der "Umweg" über das Array.
Wenn du natürlich bereits Elemente hast, die eingefärbt wurden, dann werden diese logischerweise nicht mit zurückgesetzt, da sie ja nicht in dem Array stehen - bevor der Code bei dir also tatsächlich die gewünschten Effekte hat, musst du alle Elemente erst einmal zurücksetzen.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
03.07.2015, 12:03
Hi nochmal,

wie kann ich dann die Elemente ansprechen, und die Schriftfarbe und Rahmenfarbe zurücksetzen?


Bzw. kann man dann nicht die jeweiligen Typen mit schwarzer Schrift und die mit weißer Schrift ansprechen?

Ich könnte bei den Elementen mit weißer Schrift die Schriftfarbe auch auf schwarz ändern und den Hintergrund bspw. auf Blau, falls das die Lösung einfacher machen sollte!?

Danke für deine tolle Unterstützung!!!


Gruß und sonniges Wochenende :sun:
Manuel

Beverly
03.07.2015, 12:49
Hi Manuel,

das verstehe ich jetzt gerade nicht - der Code setzt doch die Farben wieder zurück.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

xlph
03.07.2015, 19:09
Hallo Falke 89,

wie gefällt dir folgende Version...

Beverly
03.07.2015, 20:26
Hi Manuel,

ich habe gerade festgestellt, dass einige Elemente einen Standardrahmen haben - wenn du dich darauf beziehst, dass diese auch zurückgesetzt werden müssen. Hier der geänderte Code (Änderungen sind rot markiert):

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
Dim arrShapes()
Dim lngShapes As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage <> "Falsch" And varFrage <> False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 3, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.Name
arrShapes(1, lngShapes) = shaShape.DrawingObject.Font.Color
arrShapes(2, lngShapes) = shaShape.Line.ForeColor
arrShapes(3, lngShapes) = shaShape.Line.Visible
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 3, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.GroupItems(lngZaehler).Name
arrShapes(1, lngShapes) = shaShape.GroupItems(lngZaehler).DrawingObject.Font.Color
arrShapes(2, lngShapes) = shaShape.Line.ForeColor
arrShapes(3, lngShapes) = shaShape.Line.Visible
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
For lngZaehler = 0 To UBound(arrShapes(), 2)
With ActiveSheet.Shapes(arrShapes(0, lngZaehler))
.DrawingObject.Font.Color = arrShapes(1, lngZaehler)
.Line.ForeColor.RGB = arrShapes(2, lngZaehler)
.Line.Visible = arrShapes(3, lngZaehler)
End With
Next lngZaehler
End Sub


<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Falke89
06.07.2015, 08:24
Hi Beverly und xlph,

Danke für eure super Arbeit.

Jetzt funktioniert auch alles so wie ich mir das vorgestellt habe.

Das ist einfach toll, wie einem hier geholfen wird!!!


Gruß und Danke,
Manuel

xlph
10.07.2015, 14:03
Hallo,

- ist es möglich, dass die Suche "Leerzeichen" ignoriert, das heißt wenn ich "Seite 3" im Textfeld habe, dass dann der Eintrag mit Sucheintrag "Seite 3" aber auch "Seite3" gefunden wird???

Setze "*" als Platzhalter

- ist es möglich, solange das Suchfenster offen ist, an der Arbeitsmappe zu arbeiten (Ich habe bei den Endzweigen Links hinterlegt, die könnte man dann bei geöffneter/aktiver Suche öffen)


frmSuche.Show vbModeless ' (einkommentieren)
Es gibt einen weiteren Button ('Aktualisieren'). Dieser aktualisiert die Liste
falls Änderungen am Text der gefundenen Formen durchgeführt wurde.
Ist umgesetzt.

- ist es möglich, wenn kein Treffer gefunden wurde, eine Meldung "Kein Treffer" auszugeben?


Nach 'Suchergebnis:' wird jetzt die Anzahl der Funde angezeigt. 0 = Kein Fund.

- ist es möglich, die Suche zusätzlich mit Enter zu starten???
Ist umgesetzt.

Falke89
13.07.2015, 07:53
Hallo xlph,

vielen Dank für deine Hilfe, funktioniert einwandfrei :top:


Gruß Manuel

Falke89
13.07.2015, 08:02
Eine Sache hätte ich jetzt noch, weiß aber nicht ob das zu lösen ist!?

Ich habe beispielsweise in einem Textfeld wegen Platzmangel "Durchgangs-löcher" stehen.

Wenn jetzt jemand nach Durchgangslöchern sucht, kommt als Ergebnis "Keine Übereinstimmung!".
Da ja keiner weiß, dass in diesem Falle ein Bindestrich verwendet wurde, glaubt er, dass dieser Suchbegriff nicht vorhanden ist.

Könnte man das irgendwie lösen, dass Bindestriche keine Auswirkung auf das Suchergebnis haben?

Danke schonmal für die Mühe :)

Gruß Manuel

xlph
13.07.2015, 11:39
Versuche es hiermit.

Statt einer TextBox wird eine ComboBox verwendet.

Beverly
13.07.2015, 16:07
Hi Manuel,

wenn es nur um die Bindestriche im Textfeld geht, dann kann man diese im Inhalt löschen

If Application.Substitute(shaShape.DrawingObject.Text, "-", "") Like "*" & varFrage & "*" Then


Es kann dann aber nicht nach Inhalten mit Bindestrich gesucht werden. Oder du löschst sie nach dem selben Prinzip auch in der Variablen varFrage.

<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>