Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1608to1612
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
Inhaltsverzeichnis

Farbänderung Shapes Variabel

Farbänderung Shapes Variabel
22.02.2018 08:30:20
Okan
Guten Morgen,
ich würde gerne folgenden Code so abändern wollen, dass ich die Shapebezeichnung in VBA eintragen kann wie eine Liste und diese mit dem unten stehenden Code für alle Shapes ausführen.
Public Sub Farbe_LV_210621()
Dim strSuch As String, raFund As Range
strSuch = "LV_210621" 'soll variabel werden
With Worksheets("CAPO_H")
Set raFund = .Columns("B:B").Find(what:=strSuch, LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raFund.Offset(0, 9) > 999 Then
With CAPO_H.Shapes("LV_210621").Fill 'soll variabel werden
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
With CAPO_H.Shapes("LV_210621").Fill 'soll Variabel werden
.ForeColor.RGB = RGB(0, 200, 0)
End With
End If
Else
MsgBox "Suchbegriff  " & strSuch & "  in Spalte B nicht vorhanden."
End If
End With
Set raFund = Nothing
End Sub
Ich bedanke mich im Voraus.
VG
Okan

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Farbänderung Shapes Variabel
22.02.2018 09:03:57
Luschi
Hallo Orkan,
bei mir sieht das so aus:

Public Sub Farbe_LV_Manche()
Dim raFund As Range, _
strSuch As String, vArr As Variant, i As Integer
Dim notFound As String
strSuch = "LV_210621,LV_210623,LV_210626" 'soll variabel werden
vArr = Split(strSuch, ",", -1, vbTextCompare)
With Worksheets("CAPO_H")
For i = LBound(vArr) To UBound(vArr)
Set raFund = .Columns("B:B").Find(vArr(i), , xlValues, xlWhole, xlByRows, xlNext,  _
False, False, False)
If Not raFund Is Nothing Then
If raFund.Offset(0, 9).Value > 999 Then
'Ich finde es nicht gut, den Codename der Tabelle zu ändern
'With CAPO_H.Shapes("LV_210621").Fill 'soll variabel werden
With Tabelle1.Shapes(vArr(i)).Fill 'soll variabel werden
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
'With CAPO_H.Shapes("LV_210621").Fill 'soll Variabel werden
With Tabelle1.Shapes(vArr(i)).Fill 'soll Variabel werden
.ForeColor.RGB = RGB(0, 200, 0)
End With
End If
Else
notFound = notFound & vArr(i) & " - "
End If
Next i
End With
Set raFund = Nothing
If Len(notFound) > 0 Then
notFound = Left(notFound, Len(notFound) - 2)
notFound = "Folgende Begriffe nicht gefunden:" & vbCrLf & vbCrLf & notFound
i = 48
Else
strSuch = Replace(strSuch, ",", " - ", 1, -1, vbTextCompare)
notFound = "alle Begriffe gefunden!" & vbCrLf & vbCrLf & strSuch
i = 64
End If
MsgBox notFound, vbSystemModal + i, "Hinweis..."
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Farbänderung Shapes Variabel
22.02.2018 12:23:02
Okan
Guten Tag Luschi,
danke für die schnelle Rückmeldung.
Ich hätte da einen anderen Ansatz gehabt, damit das Ausührende Makro leichter zu lesen ist.
Ich würde das Makro eigentlich so belassen wollen, nur dass die Shapebezeichnungen Variabel sein sollen.
Die Varable soll dann in einem Makro in dem Sheet in dem sich die Shapes bedinfen definiert werden:
Bsp.:
im Sheet1 folgendes Makro
Private Sub Worksheet_Open()
Call Farbe_LV_Manche(Shape("LV_..."))
End Sub
ist das Möglich?
VG
Okan
AW: Farbänderung Shapes Variabel
22.02.2018 15:03:52
Luschi
Hallo Orkan,
was hindert Dich denn, den Code so umzuschreiben:

Private Sub Worksheet_Open()
Dim xStrSuch As Sting
xStrSuch= "LV_210621,LV_210623,LV_210626" 'soll ist variabel
Call Farbe_LV_Manche(xStrSuch)
End Sub
Sub Farbe_LV_Manche(strSuch As string)
Dim raFund As Range, _
vArr As Variant, i As Integer, notFound As String
vArr = Split(strSuch, ",", -1, vbTextCompare)

'und weiter wie bisher
Gruß von Luschi
aus klein-Paris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige