Wörter in Textfeldern per Makro suchen

Sub Suchen_alle_Tabellen() Dim wks As Worksheet Dim Shpe As Shape Dim strFind As String strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch) If strFind = "" Then Exit Sub For Each wks In Worksheets For Each Shpe In wks.Shapes If Shpe.Type = msoTextBox Then If Shpe.DrawingObject.Caption & "," Like "*" & strFind & ",*" Or _ Shpe.DrawingObject.Caption & "," Like "*" & strFind & Chr(10) & "*" Or _ Then MsgBox "Suchtext gefunden in: " & Shpe.Name & " " & wks.Name End If Next Next wks strSuch = strFind MsgBox "Keine weiteren Fundstellen!", False, Application.UserName End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Suchen_alle_Tabellen() Dim wks As Worksheet Dim Shpe As Shape Dim strFind As String strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch) If strFind = "" Then Exit Sub For Each wks In Worksheets For Each Shpe In wks.Shapes If Shpe.Type = msoTextBox Then MsgBox Len(Shpe.DrawingObject.Caption) If Shpe.DrawingObject.Caption & "," Like "*" & strFind & ",*" Or _ Shpe.DrawingObject.Caption & "," Like "*" & strFind & Chr(10) & "*" _ Or _ Then MsgBox "Suchtext gefunden in: " & Shpe.Name & " " & wks.Name End If Next Next wks strSuch = strFind MsgBox "Keine weiteren Fundstellen!", False, Application.UserName End Sub

Da wäre noch was, Reinhold;
es wurden dir ja schon Ursachen angedeutet, aber eher nicht der ganze Hintergrund:
1. Auch in Versionen vor Xl12/2007, zumindest aber ab Xl9/2000 konnte man Texte>255 Zeichen in Textfeldern unterbringen, …
1.1 manuell durch Eintrag,
1.2 per VBA nur durch Anstückeln, d.h., direkt auf 1× nur 255 Zeichen, weiteren Text nur mit der Characters.Insert-Methode des Shapes.TextFrame-Objekts.
→ Folglich ist Daniel zuzustimmen, dass du mit deinem Pgm wahrscheinlich nicht den ganzen Text ausliest.
2. Analog muss man dann natürlich auch im umgekehrten Fall vorgehen. Man muss den Objekt-Text stückweise auslesen und dabei in einer Variable wieder zusammensetzen. Ich habe das mit einer UDF an einem 1978 Zeichen langen Text in einem Textfeld getestet, allerdings unter Xl14/2010. Aber die UDF stammt aus einer Zeit als ich noch mit Xl9/2000 gearbeitet hatte, sollte also bei dir ebenfalls fktionieren.
3. Das andere Problem wäre ggf der Like-Operator. Aber da es sich hierbei in VBA um einen Operator und keine Fkt handelt, sollte er auch mit dem überlangen Text fktionieren. Meine UDF, die ihn verwendet, kam jedenfalls mit dem o.g. Text zurecht.
Meine Lösung:
Ich habe beide UDFs in einer ZellFml angewendet, wobei sie in 2 Varianten alle Auftritte des SuchBegriffs Count gefunden haben. Leider verfügst du nicht über die notwendigen VBA-Kenntnisse, um die Wirkungsweise der beiden UDFs zu verstehen, aber dazu wird ja einiges unter den nachfolgd ArchivLinks geschrieben. Nur noch soviel, die beiden Varianten kommen durch VLike zustande, mit der man einen Text von vorn nach hinten (Arg3=1) oder umgekehrt (Arg3=-1) durchsuchen kann (Arg3=0 stellt nur fest, dass der SuchBegriff im Text enthalten ist). Dabei wird vorwärts die Position des letzten Zeichens des SuchBegriffs (1.Auftreten), rückwärts die des 1.Zeichens (letztes Auftreten) ausgegeben. Für weitere Auftritte muss der Text vorn bzw hinten gekürzt wdn, was im Rückwärtsfall einfacher ist (die Reihe endet mit 0, im Vorwärtsfall mit Wiederholung des letzten Positionswerts).
Die Fmln sähen dann so aus:
&bullet; 1.Formel ("sbNRN1.0" ist der Name des Textfelds, das einen PgmText enthält [deshalb hier Count als SuchBegriff]):
- Vorwärts in T25: =VLike(TextOf(T(JETZT())&"sbNRN1.0";1);"*Count*";1)
- Rückwärts in U25: =VLike(TextOf(T(JETZT())&"sbNRN1.0";1);"*Count*";-1)
&bullet; 2. u.weitere Fmln (nach unten ziehen; S24=TextGesamtLänge):
- Vorwärts (T26ff): =VLike(TEIL(TextOf(T(JETZT())&"sbNRN1.0";1);T25+1;S$24);"*Count*";1)+T25
- Rückwärts (U26ff): =VLike(LINKS(TextOf(T(JETZT())&"sbNRN1.0";1);U25-1);"*Count*";-1)
Die Einfügung T(JETZT())& vor dem 1.Argument von TextOf ist dem Umstand geschuldet, dass die TestDatei mehrere Blätter enthält, darunter eines mit weiteren Textfeldern. Xl neigt dazu, nicht nur das aktive Blatt zu berechnen, sondern auch UDFs in nicht-aktiven, sucht Shapes aber nur im aktiven. Da die UDF nicht volatil ist, habe ich eine volatile Xl-Fkt in die Fml eingebaut, so dass bei FalschAnzeige auch ein Klick in eine beliebige leere Zelle reicht, um das Ergebnis richtigzustellen. Die evtl Notwendigkeit dieser Fml-Ergänzung hängt also von der jeweiligen Anwendungssituation ab.
Die Länge des GesamtTextes kann übrigens so ermittelt wdn: =LÄNGE(TextOf(T(JETZT())&"sbNRN1.0";1))
UDF-ArchivLinks:
TextOf (Vs1.1) https://www.herber.de/forum/archiv/1108to1112/1110195_bedingte_Formatierung_anhand_Datum_i_Kommentar.html#1110437
VLike (Vs1.2 o.VPairs) https://www.herber.de/cgi-bin/callthread.pl?index=1247144#1247699
Morhn, Luc :-?

Vielen Dank, Luc, für diese umfangreiche Antwort! In der Tat ist mir diese Lösung ein paar Nummern zu hoch.
Also, ich habe in einer Excel-Arbeitsmappe in Tabelle1 vier Textfelder mit den Nummern 2,3,5 und 8. Alle enthalten verschiedene Wörter, welche teils mit Komma, teils mit Bindestrich getrennt sind. In Textfeld 2 und 8 befinden sich u.a. die Wörter "sechs" und sind mehr als 255 Zeichen vom Textfeldanfang entfernt. Außerdem befinden sich in weiteren Tabellenblättern Textfelder mit Wörtern, welche auch durchsucht werden sollen.
Ich habe nun in Tabelle1 folgende Formeln eingefügt:
In Zelle T25: =VLike(TextOf(T(JETZT())&"sbNRN1.0";1);"*Count*";1)
In Zelle U25: =VLike(TextOf(T(JETZT())&"sbNRN1.0";1);"*Count*";-1)
In Zelle T26: =VLike(TEIL(TextOf(T(JETZT())&"sbNRN1.0";1);T25+1;S$24);"*Count*";1)+T25
und hinuntergezogen bis T39
In Zelle U26: =VLike(LINKS(TextOf(T(JETZT())&"sbNRN1.0";1);U25-1);"*Count*";-1)
und hinuntergezogen bis U39
In Zelle S24: =LÄNGE(TextOf(T(JETZT())&"sbNRN1.0";1))
Alle diese mit den Formeln befüllten Zellen zeigen: #NAME?
Wenn ich das Wort "sechs" suchen will, wo muß ich es eingeben, dass es in den Textfeldern gesucht wird?
Muß ich den Formelteil "sbNRN1.0" noch irgendwie an meine Exceldatei anpassen, wenn ja, wo und wie?

Function Test() =VLike(TextOf(T(JETZT())&"Text Box 2";1);"*sechs*";1) =VLike(TEIL(TextOf(T(JETZT())&"Text Box 2";1);T25+1,S$24);"*sechs*";1)+T25 =VLike(TextOf(T(JETZT())&"Text Box 2";1);"*sechs*";-1) =VLike(LINKS(TextOf(T(JETZT())&"Text Box 2";1);U25-1);"*sechs*";-1) End Function

Sub Test() =VLike(TextOf(T(JETZT())&"Text Box 2";1);"*sechs*";1) =VLike(TEIL(TextOf(T(JETZT())&"Text Box 2";1);T25+1,S$24);"*sechs*";1)+T25 =VLike(TextOf(T(JETZT())&"Text Box 2";1);"*sechs*";-1) =VLike(LINKS(TextOf(T(JETZT())&"Text Box 2";1);U25-1);"*sechs*";-1) End Sub

Sub Suchen_alle_Tabellen() Dim wks As Worksheet Dim Shpe As Shape Dim strFind As String Dim strText As String strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch) If strFind = "" Then Exit Sub For Each wks In Worksheets For Each Shpe In wks.Shapes If Shpe.Type = msoTextBox Then strText = TextOf(Shpe.Name, 1) MsgBox Len(strText) 'optional zum Testen If strText & "," Like "*" & strFind & ",*" Or _ strText & "," Like "*" & strFind & Chr(10) & "*" Then MsgBox "Suchtext gefunden in: " & Shpe.Name & " " & wks.Name End If End If Next Next wks strSuch = strFind MsgBox "Keine weiteren Fundstellen!", False, Application.UserName End Sub

Beliebteste Forumthreads (12 Monate)

Wörter in Textfeldern per Makro suchen

28
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wörter in Textfeldern per Makro suchen

28 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

28
Beiträge zum Forumthread

Beiträge zu diesem Forumthread