Hallo allerseits,
ich bin's mal wieder mit einer Anfrage, die meinen vorherigen Fragen stark ähnelt. Ich schaffe es allerdings irgendwie nicht die Übertragungsarbeit zu leisten.
Ich möchte gerne jeden einzelnen Zelleneintrag eines Bereiches mit allen Text vergleichen, die in bestimmten Formen angezeigt werden. So was Ähnliches musste ich schon mal machen, nur andersrum (Text einzelner Form in Bereich suchen). Leider kann man den Code wohl nicht einfach so umkehren, wie ich es mir zunächst erhofft habe. Kann mir bitte jemand helfen? Schon mal vielen Dank dafür.
Beste Grüße
Corina
P.S.: Ziel des Ganzen ist es eines Tages automatisch Shapes zu erstellen anhand von bestimmten Zelleinträgen.
Option Explicit
Sub CreateShapes()
Dim ws As Worksheet
Dim SrchRng
Dim shp As Excel.Shape
Dim c As Range
Dim cellEntry As String
Dim lastRow
On Error GoTo ErrHandler
Set ws = Worksheets("Lists")
lastRow = ws.Cells(Rows.count, 1).End(xlUp).row
With Worksheets("Checklist Structure")
For Each shp In .Shapes
If shp.Type = msoAutoShape Then
If shp.AutoShapeType = msoShapeRoundedRectangle Then
cellEntry = ws.Range("D3:P" & lastRow).Cells.Value
SrchRng = shp.TextFrame2.TextRange.Characters.Text
Set c = SrchRng.Find(cellEntry, LookIn:=xlValues)
If Not c Is Nothing Then
MsgBox ("Succes!")
End If
End If
End If
Next shp
End With
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Error " & Err.number)
End Sub
|