Excel Ampel Makro bei erneutem Klick wieder weiß?

Hallo ihr Lieben,

ich verzweifel gerade.

Ich möchte in Excel über Makros eine Ampel erstellen, wo man die Kreise jeweils nur anklicken muss, damit sie rot, gelb oder grün werden.

Wenn der Kreis weiß ist funktioniert das auch sehr gut mit dem Farbwechsel beim anklicken. Aber wie bekomme ich es hin, dass der Kreis bei erneutem anklicken wieder weiß wird? Bei erneutem Klicken bleibt er nämlich rot.

Hier mal der Code mit dem ich es versucht habe zu löse, allerdings klappt das nicht. Bin leider absoluter Anfänger in Sachen Makros aber brauche das für die Arbeit.

Vielen Dank im Voraus :)

Sub Test1()

' ' Test1 Makro '

ActiveSheet.Shapes.Range(Array("Flowchart: Connector 2")).Select
If (ForeColor = RGB(255, 0, 0)) Then

   With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
End With

Else

With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
    .Solid
    
    End With
    
    End If

End Sub

2 Antworten

Vom Fragesteller als hilfreich ausgezeichnet

Ninombre

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

18.04.2017, 17:27

macht es ggf. Sinn beim Klick auf eines der drei Objekte die jeweils anderen auf Weiß zu setzen, unabhängig welche Farbe sie zuvor hatten? Bei einer Ampel (Statusampel) kann ja nur gleichzeitig eine Farbe aktiv sein.

Andersformuliert: Keine Abfrage auf den bisherigen Farbstatus, sondern rot färben und die beiden anderen weiß

ActiveSheet.Shapes.Range(Array("Oval 1")).Fill.ForeColor.RGB = RGB(255, 255, 0)
ActiveSheet.Shapes.Range(Array("Oval 2")).Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveSheet.Shapes.Range(Array("Oval 3")).Fill.ForeColor.RGB = RGB(255, 255, 255)

den Rest brauchst Du vermutlich gar nicht an Einstellungen, wenn es einfach nur rot, gelb, grün bzw. weiß sein soll.
In meinem Beispiel heißen die Objekte eben Oval 1 - 3, musst Du bei Dir entsprechend anpassen.

missunperfect

Fragesteller

12.05.2017, 09:51

Hat so funktioniert danke, habe das mit dem wieder weiß einfach durch einen Reset Knopf gelöst :)

PeterKremsner

18.04.2017, 11:54

Mach bei deiner Anweisung wenn die Farbe Rot ist ein :

.ForeColor.RGB = RGB(255,255,255)

rein, damit setzt du den Wert dezidiert auf weiß.

Btw hast du schon mal versucht das ganze zu debuggen, setz mal einen Breakpoint in die beiden Zweige des If, vielleicht wird einer gar nicht ausgeführt.

Ähnliche Fragen

VBA Grafik in die Kopfzeile per Makros?

Guten Tag,

gerne möchte ich per Makros eine Grafik in die Kopfzeile packen. Dabei habe ich folgendes zusammengebastelt:

With Sheets("Kundenbeleg").PageSetup
.CenterFooterPicture.Filename = "C:\Users\Robin\Desktop\Test.png"
.CenterFooter = "&G"
End With

Der Sheets ist korrekt und der Speicherpfad auch. Der Quelltext ist ein Auszug aus einem Makro, in dem die Seite Kundenbeleg als PDF gespeichert wird.

Die Speicherung funktioniert, nur leider ohne die "Test"-Grafik.

Habe ich noch etwas vergessen?

Gruß

...zur Frage

Excel Makro automatisch wiederholen loop schleife

Hi liebe community,

ich benutze in microsoft excel oft die Aufzeichnungsfunktion eines Makros (macro record). Z.b. haben ich in meinem aktuellen Fall eine tabelle und habe mit der funktion makro record einmal aufgenommen dass sich die zehnte zeile rot färbt. Ich will natürlich dass das makro weitermacht automatisch bis es das ende der datenstruktur bzw. bis zu der zeile, wonach keine zahlen mehr folgen. denn derzeit hört mein makro nach einem mal sofort auf (es macht einmal GENAU das, was ich ihm gezeigt habe)

Die Frage lautet nun: was muss ich für mein Ziel für ein code im makro ergänzen, dass es weitermacht?

Vielen Dank schon mal für alle Antworten! lg :)

...zur Frage

Name einer Shape(Rectangle) ändern und löschen in VBA?

Mithilfe eines Makros in VBA erstelle ich ein Rechteck an einer bestimmten Stelle, was wiederum dann beim nächsten Öffnen der Datei an einer anderen Stelle erstellt wird. Dass dann nicht nach einer gewissen Zeit das Blatt voll ist mit Rechtecken, würde ich gerne bei bei Start eine Range nach diesem Rechteck durchsuchen und löschen, bisher mache ich das so:

    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
           If shp.Name = "HeuteRechteck" Then
              shp.Delete
           End If
Next

Hier bekomme ich allerdings "Objekt unterstützt diese Eigenschaft oder Methode nicht", was womöglich an der Benennung liegt. Benennen u.a. tue ich das Rechteck so:

ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, 12, 795).Select
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange.Fill.Shapes(1)
    .Visible = msoTrue
    .ForeColor.RGB = RGB(146, 208, 80)
    .Transparency = 0.5
    .Name = "HeuteRechteck"

Mach ich beim Benennen was falsch?

Habt ihr irgendwelche Ideen oder Ansätze?

...zur Frage

Excel Makro x nur einmal ausführen. nächstes mal wieder ausführbar wenn makro y vorher ausgeführt wurde?

guten morgen, bekomme es einfach nicht hin, dass makro 2 nur einmal ausgeführt wird und das nächste mal wieder ausführbar ist wenn ich vorher makro 1 betätigt habe. makro 1 speichert bestimmte daten, die in eingabefelder eingegeben wurde und leert diese anschließend. mit dem 2. makro kann man die zuletzt eingegebene daten zurückrufen und bearbeiten. natürlich soll dies nciht endlos gehen, da sonst alle jemals einegegebene daten gelöscht/ überschriebeen werden indem man oft genug auf makro 2 ("bearbeiten") drückt. hier ist schon mal der anfang den ich mir zusammengebastelt habe:

Sub zurückbutton()



Select Case KlickNr

   Case 0: Call bearbeitenbuttonteil1
   Case 1: Call MsgBox("Nur die zuletzt eingegebene Daten können bearbeitet werden.")

End Select
KlickNr = KlickNr + 1
If KlickNr >= 1 Then
End Sub

nun ist es leider so, dass der button trotzdem unendlich male ausgeführt werden kann. ich habe es mit end with und exit versucht aber dann bekäme ich es ja nciht wieder hin, dass der button aktiviert wird nachdem ich makro 1("speichern") gedrückt habe

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

Excel VBA - Darstellung waagerecht-vertikal beim kopieren ändern?

Hallo,

ich habe in einer fertigen Tabelle etwas geändert, um die Eingabe der Daten zu erleichtern. Statt die Daten in der Spalte zu erfassen, werden die Daten jetzt in einer Zeile eingegeben.

Also statt vorher in B10, B11, B12... jetzt in B10, C10, D10...

Die Daten werden mit Hilfe eine Makros in eine andere Tabelle transferiert und waagerecht eingefügt.

Da ich aber die Eingabeart verändert habe, werden die Daten jetzt untereinander in die Tabelle eingefügt.

Ich weiß, dass das mit "Application.Transpose" zu tun hat.

Nun weiss ich aber nicht wie ich die Zeile umbenennen muss, damit die waagerechte Darstellung übernommen wird.

Wie ändere ich die Zeile, damit die angesprochenen Werte waagerecht in die Zeile kopiert werden?

Hier der komplette Code:

Sub transfer_werte()
    Dim rngKunde    As Excel.Range
    Dim rngReklam   As Excel.Range
    Dim rngArtikel   As Excel.Range

     Set rngKunde = Worksheets("Eingaben").Range("C5:C10")
    Set rngReklam = Worksheets("Eingaben").Range("D5:D9")
    Set rngArtikel = Worksheets("Eingaben").Range("C14:L14")
   
        With Worksheets("Liste")
          With .Cells(.Rows.Count, 2).End(xlUp)
               .Offset(1, 0).Resize(rngKunde.Columns.Count, rngKunde.Rows.Count).Value = Application.Transpose(rngKunde.Value)
        End With
    End With
   
    With Worksheets("Liste")
        With .Cells(.Rows.Count, 8).End(xlUp)
             .Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value)
        End With
    End With
  
   With Worksheets("Liste")
        With .Cells(.Rows.Count, 14).End(xlUp)
             .Offset(1, 0).Resize(rngArtikel.Columns.Count, rngArtikel.Rows.Count).Value = Application.Transpose(rngArtikel.Value)
        End With
    End With
      
End Sub

...zur Frage

Warum wird VBA durch Optimierung langsamer?

Liebe Community,

ich habe über den Makroaufnahme ein umfangreiches Makro aufgenommen. Typisch dafür ist, dass oft der Befehl Select benutzt wird. Da ich gelesen habe, dass dadurch die Geschwindigkeit verlangsamt wird und weggelassen werden sollte, habe ich das so befolgt.

Vorher ist das Makro innerhalb weniger Sekunden durchgelaufen, jetzt braucht es circa eine Minute. Ich habe mal ein Beispiel angehängt, wo man den Zeitverlust sehr deutlich bemerkt.

Habe ich da was falsch gemacht?

Vorher:

    Cells.Select
    Range("B13").Activate
        With Selection.Font
            .Name = "Calibri"
            .Size = 14
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With

Nachher:

With Cells.Font
        .Name = "Calibri"
        .Size = 14
        .ThemeColor = xlThemeColorLight1
        .ThemeFont = xlThemeFontMinor
    End With

Ich habe eher wenig Ahnung von VBA, habe mich durch Ausprobieren und Internetseiten rumgeschlagen.

Vielen Dank schonmal für Antworten.

Lamio13

...zur Frage

CSV am Ende einer Exceltabelle einfügen?

Hi,

folgendes Szenario: Ich bekomme in unterschiedlichen Zeitabständen CSV Dateien die ich in Excel importieren möchte. An sich ist das ja kein Problem. Jedoch möchte ich den ganzen Schritt automatisieren und die Daten der CSV an das Ende einer formatierten Tabelle setzen. Hat folgenden Hintergrund: Ich möchte über die Daten der CSV Dateien mehrere Auswertungen laufen lassen. Diese müssen nur einmal angelegt werden und danach immer über alle Daten aus allen CSVs laufen. Die Daten aus den CSV Dateien werden einmalig Importiert, also sind keine Dateiverbindungen nötig. Mein erster Gedankengang war ein Excelsheet "Import" in welches ich die Daten lade und dann per Makro ans ende der Tabelle schiebe. Doch da war mein Problem ein VBA-Skript zu schreiben welches immer an die nächste freie Stelle die Daten kopiert. Eventuell gibt es ja auch eine einfachere Lösung und ich finde Sie nicht. Ich habe Excel2016 im Einsatz und keine Einschränkungen in Sachen Makros. Zudem ist es eine 64bit Version welches die Verarbeitung großer Makros relativ zügig funktioniert.

Vielen Dank im Voraus für alle Antworten

Grüße

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

VBA Makro Excel Letzte beschriebene Zeile vor Leerzeile, weitere Leerzeile einfügen

Guten Tag,

ich suche einen Code für ein Makro,dass in Spalte B unter der letzten beschriebenen Zelle vor einer leeren Zelle (also nicht am kompletten Ende des Sheets) eine Leerzeile einfügt. Habe schon etliche codes ausprobiert, zb

Sub letzte_Zeile()

'letzte benutzte Zelle in Spalte 2 finden DIM Ende As Long With ActiveSheet

Ende = .Cells(Rows.Count, 2).End(xlUp).Row End With

End Sub

Dieser sollte mir eig die letzte beschriebene Anzeigen,es funktioniert aber Garnichts.

Freue mich über Vorschläge. Viele Grüße

...zur Frage

Excel VBA Makro - Bilder und Link?

Der folgende Code fügt ein Bild aus einer URL ein.

Ist es möglich das eingefügte Bild mit dem dazugehörigen Hyperlink zu hinterlegen. Also wenn man das Bild dann anklickt, direkt auf die Webseite des Bildes geleitet wird.

Wie muss man den Code ändern?

Function InsertPicFromURL(URL As String) As String

With ActiveSheet.Pictures.Insert(URL)

.Top = Application.Caller.Top

.Left = Application.Caller.Left

.Height = Application.Caller.Height

InsertPicFromURL = ""

End With

End Function

...zur Frage

Excel mit Makros teilen + Blätter in Leiste ausblenden?

Hallo,

zum 1. Thema. Ich mache eine Excel mit Makros für meine Firma und in meiner Datei kann ich alle Makros ohne Probleme abspielen. Wenn ich die Tabelle aber nur in ein anderes Programm z.B OneNote kopiere, kann ich die Makros nicht mehr aktivieren.

Es kommt dann "Das Makro ... kann nicht ausgeführt werden . Das Mako ist möglicherweise in dieser Arbeitsmappe nicht verfügbar, oder alle Makros sind deaktiviert.

=> ich habe bei dem Trust Center die Makros aktiviert

Wenn ich dann in der Mappe bei einem Objekt ein Makros zuweisen will, kommt diese Tabelle wo alle meine Makros da sind aber wenn ich dann zuweisen will kommt "Aufgrund von Sicherheitseinstellungen wurden Makros deaktiviert. Zum Ausführen von Makros müssen Sie diese Arbeitsmappe erneut öffnen und dann Makros aktivieren. ...

Wisst ihr wie man das beheben kann um das auch für mehrere Personen verfügbar zu machen?

Zum zweiten Thema konnte ich nicht das finden was ich brauchte. Ich z.B zwei Tabellenblätter (A und B). A stellt die Startseite dar und B ist unten in der Liste/Leiste ausgeblendet. Klicke ich auf ein Makro auf A soll das Blatt B eingeblendet werden und A in der Leiste ausgeblendet werden. Widerum soll es dann möglich sein durch ein Makro von B auf A zu gelangen und dass sich B wieder in der Leiste ausblendet?

Ich hoffe das ist nicht zu wirr geschrieben und bitte habt erbarmen mit mir, ich mache das hier zum ersten Mal.

Viele Grüße und danke im Voraus

Jamie

...zur Frage

Werte aus Tabelle mit Makro archivieren?

Hallo Zusammen, ich habe mir ein Makro aufgezeichnet, welches Werte aus einer Tabelle in ein anderes Tabellenblatt kopiert. Die Werte in der Ursprungstabelle ändere ich aber ständig und ich will, dass beim aktivieren des Makros, die zuvor kopierten Werte nicht überschrieben werden sondern neben den bereits "archivierten" Werten eingefügt wird. So sieht das Makro bis jetzt aus:

Sub test() ' test Makro Range("C5:D19").Select Selection.Copy Sheets("Tabelle1").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Tabelle2").Select Range("A7:B8").Select Application.CutCopyMode = False Selection.Copy Sheets("Tabelle1").Select Range("A18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Tabelle2").Select Application.CutCopyMode = False Range("C7:C19").Select Selection.ClearContents Range("C7").Select Sheets("Tabelle1").Select Range("D2").Select Sheets("Tabelle2").Select End Sub

Problem ist, dass die alten Werte in dem neuen Tabellenblatt immer überschrieben werden. Könnt Ihr mir eine Funktion nennen, damit die Werte nicht überschrieben werden, sondern bei jedem mal ausführen des Makros die Werte in eine neue Spalte kopiert werden.

Vielen Dank im Voraus. Grüße Stephan

...zur Frage

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen