Farbe per Zahl ändern
#1
Hallo zusammen.

Bin ein Anfänger was EXCEl angeht, aber versuche mich zu bessern  Angel

Ich bin an einem Projekt dran und brauche eure Hilfe.

Bis jetzt wollte ich beim anklicken von einem Objekt, das er sich dreht und Farbe wechselt:

Sub Umfärben()
Dim Farbe(1 To 4)

Farbe(1) = RGB(84, 130, 53)
Farbe(2) = RGB(169, 209, 142)
Farbe(3) = RGB(172, 0, 0)
Farbe(4) = RGB(169, 209, 143)

With ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
    Select Case .RGB
        Case Farbe(2): .RGB = Farbe(3)
        Case Farbe(3): .RGB = Farbe(4)
        Case Farbe(4): .RGB = Farbe(1)
        Case Farbe(1): .RGB = Farbe(2)
        Case Else: .RGB = Farbe(2)
    End Select
   
End With

'
' drehen Makro
'

'
    ActiveSheet.Shapes.Range(Application.Caller).Select
    Selection.ShapeRange.IncrementRotation 315
    Range("M30").Select
       
End Sub


Bis jetzt alles funktioniert.

Nächstes Problem wo ich habe ist: Ich möchte das durch eine Zahl Farbe von bestimmten Objekt ändern. z.B. in der spalte G10 wird Temperatur angezeigt "50" °C und eine Rohr(Linie) hat eine braune Farbe, wenn ich jetzt die Zahl von 50 auf 60 verändere(in der Zeile G10), dann soll sich die Linie eine andere Farbe annehmen usw..

Also Überlegung ist:
50-60 => Farbe braun
60-70 => Farbe xxx
70-80 => Farbe xxx
....
90-100 => Farbe rot

Kann mir bitte mir jemanden helfen wie ich durch Makro oder sonst wie hinbekommen kann?! mir ist das sehr wichtig  :69:

Ich bin für jede Hilfe sehr Dankbar!

MfG Andre
Top
#2
Hi

Versuch es so.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Farbe

If Target.Address = "$G$10" Then
  Select Case Target.Value
    Case 50 To 59
        Farbe = RGB(255, 0, 0)
    Case 60 To 69
        Farbe = RGB(255, 255, 0)
  End Select
  If Farbe <> "" Then
    ActiveSheet.Shapes("Rohr1").Line.ForeColor.RGB = Farbe
    Target.Select
  End If
End If

End Sub
Gruß Elex
[-] Folgende(r) 1 Nutzer sagt Danke an Elex für diesen Beitrag:
  • Andrek
Top
#3
Vielen Dank, Elex.

Aber leider klappt bei mir nicht.

Ich habe diesen Code als Modul eingefügt und meine Linie(Rohr) auch als "Rohr1" genannt, dann an der Stelle G10 verschiedene Zahlen angegen => passiert nichts, dann habe ich probiert als Makro usw.. leider klappt irgendwie nichts  :22:
Top
#4
hast du  mal einen Haltepunkt in dein Worksheet_change Ereignis gesetzt? Damit weis man wenigstens das der Code abgearbeitet wird.
[-] Folgende(r) 1 Nutzer sagt Danke an ralf_b für diesen Beitrag:
  • Andrek
Top
#5
(25.07.2020, 20:53)ralf_b schrieb: hast du  mal einen Haltepunkt in dein Worksheet_change Ereignis gesetzt? Damit weis man wenigstens das der Code abgearbeitet wird.
Hallo Ralf,

also es ist für mich ein dunkler Wald, aber wenn ich dich richtig verstanden habe - ich habe am Ende(vor End Sub) einen Code dazu geschrieben: Range("M30").Select , das bedeutet , wenn alles richtig abgespielt wird wird die Zeile M30 angewählt? Meinst du das?

Wenn ich richtig liege, dann klappt das auch nicht, egal was ich in der Zeile G10 angebe  :92:
Top
#6
Hallo,

(25.07.2020, 20:39)Andrek schrieb: Ich habe diesen Code als Modul eingefügt ...

Der Code gehört in das schon vorhandene VBA-Modul des entsprechenden Tabellenblattes. Wink

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Andrek
Top
#7
(25.07.2020, 20:53)ralf_b schrieb: hast du  mal einen Haltepunkt in dein Worksheet_change Ereignis gesetzt? Damit weis man wenigstens das der Code abgearbeitet wird.
Ich habe gerade bißchen gegoogelt und folgenden Code in die Tabelle dazugefügt:

Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$G$10" Or Target.Address = "$C$1" Then
MsgBox "Sie haben gerade Zelle G10 oder C1 verändert!"
End If
End Sub

Und wenn ich die Zeile G10 verändere, dann kommt Meldung: Sie haben gerade Zelle G10 oder C1 verändert! Blush

(25.07.2020, 21:13)Kuwer schrieb: Hallo,


Der Code gehört in das schon vorhandene VBA-Modul des entsprechenden Tabellenblattes. Wink

Gruß Uwe
Schon verstanden  Angel :23:
Top
#8
Da es laut PN immer noch Klemmt hier mal die Datei.

.xlsm   Linie Färben.xlsm (Größe: 14,2 KB / Downloads: 2)

Gruß Elex
[-] Folgende(r) 1 Nutzer sagt Danke an Elex für diesen Beitrag:
  • Andrek
Top
#9
(26.07.2020, 13:03)Elex schrieb: Da es laut PN immer noch Klemmt hier mal die Datei.


Gruß Elex
Ich werde verrückt! Es funktioniert!  :23: :23: :98:

Jetzt ist mir klar,was ich falsch gemacht habe! Fehler behoben!  :33:

Ich danke allen für eure Mühe und Geduld!

Viele Grüße
Andre
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste