Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1560to1564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Text in Textbox finden
26.05.2017 21:39:30
Marcel
hallo,
Folgendes möchte ich tun:
: auf Tabellenblatt 1 steht einen Spalte, in jeder Zelle befindet sich ein String
: bei Doppelclick auf Zelle soll dieser String in den Textboxen auf den folgenden Steiten gesucht werden.
: bei Match soll die textbox einen roten Hintergund bekommen.
das was ich geschrieben habe, funktioniert leider nicht zuverlässig, sobald ich ander userforms hinzufüge und dannach wieder eine Textbox, sucht das Programm nicht in den neu erstellten Textboxen
hier das File:
https://www.herber.de/bbs/user/113814.xls
Gibt es ideen hierzu?

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text in Textbox finden
27.05.2017 02:47:21
fcs
Hallo Marcel,
probiere es mal mit dem nachfolgen angepassten Makro.
Die Neunummerierung der Textboxen hab ich mal in ein separates Makro gepackt.
Gruß
Franz
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
'Variablen deklarieren
Dim Suchbegriff As String, Textfeldtext As String
Dim found As String
Dim i As Integer, ifound1st As Integer
Dim shp As Shape
Dim ws As Worksheet
'Bei einem Laufzeitfehler zur Fehlerbehandlung springen
On Error GoTo Fehler
'Hintergrundfarbe in Spalte entfernen
Columns(Target.Column).Interior.ColorIndex = xlNone
'Suchbegriff merken und gewaehlte Zelle mit gelb hinterlegen
With Target
Suchbegriff = .Value
.Interior.ColorIndex = 6
End With
Application.ScreenUpdating = False
found = "no"
For i = 2 To ActiveWorkbook.Worksheets.Count
Set ws = Worksheets(i)
With ws
.Select
'For Each-Schleife zum Ansprechen aller in dem Tabellenblatt eingesetzten Shapes
For Each shp In ws.Shapes
'prüfen ob Shape = Textbox
If shp.Type = msoTextBox Then
Textfeldtext = ""
With shp.Fill
'Bei dem Textfeld die Hintergrundfarbe zurücksetzen
.ForeColor.SchemeColor = 1
.Visible = msoTrue
'Den Text aus dem Textfeld auslesen und in Variable "Textfeldtext" schreiben
Textfeldtext = shp.TextFrame.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
If found = "no" Then ifound1st = i
found = "yes"
'Hintergrundfarbe in rot ändern
.ForeColor.SchemeColor = 10
.Visible = msoTrue
shp.TopLeftCell.Select 'Zelle zum Shape selektieren
End If
End With
End If
Next shp
End With
Next i
If found = "no" Then
Cancel = True
Worksheets(1).Activate
MsgBox "Suchbegriff """ & Suchbegriff & """ nicht gefunden!"
Else
Worksheets(ifound1st).Select
Application.ScreenUpdating = True
With ActiveWindow
.ActiveCell.Show
End With
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub
Sub Textboxen_neu_nummerieren()
'Textboxen neu nummerieren
Dim i As Integer, iCount as Integer
Dim ws As Worksheet, shp As Shape
Application.ScreenUpdating = False
For i = 2 To ActiveWorkbook.Worksheets.Count
Set ws = Worksheets(i)
With ws
iCount = 0
'Temporären Namen/Nummer ergeben
For Each shp In ws.Shapes
'prüfen ob Shape = Textbox
If shp.Type = msoTextBox Then
iCount = iCount + 1
shp.Name = "tempTextBox" & Format(iCount, "000")
End If
Next
'"temp" bei den Namen wieder entfernen
For Each shp In ws.Shapes
'prüfen ob Shape = Textbox
If shp.Type = msoTextBox Then
shp.Name = Mid(shp.Name, 5)
End If
Next
End With
Next
End Sub

Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige