Live-Forum - Die aktuellen Beiträge
Datum
Titel
30.03.2024 10:00:33
30.03.2024 09:25:50
29.03.2024 22:47:55
Anzeige
Archiv - Navigation
1336to1340
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

Objekte erstellen und gruppieren

Objekte erstellen und gruppieren
15.11.2013 08:46:12
Andi
Guten Morgen,
ich versuche schon Weile eine via VBA erstellte Ampel zu gruppieren. Die Gruppe benötige ich, weil der Anwender die gesamte Ampel bei Ersterstellung auf dem Blatt korrekt positionieren muss.
habe es auf versch. Arten probiert, jedoch keinen Erfolg. Kann mir jemand bitte einen Tipp geben?
Ich möchte die einzelnen Farben (Kreise) in Variablen belassen, da ich in der Folge via VBA ein automatisches Umschalten einbauen will. Die Ampel befindet sich auf einer Blattvorlage die immer wieder als Basisblatt kopiert wird, um neue Blätter zu erhalten.
DANKE
  • 
    Sub baueeineampel()
    ' Ampel erstellen
    Dim rot As Shape
    Dim gelb As Shape
    Dim green As Shape
    Dim rah As Shape ' Rahmen
    Dim ampel As Shape ' Gruppierung
    Set rah = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 98, 98, 32, 92)
    rah.Fill.ForeColor.RGB = RGB(255, 255, 255)
    rah.LockAspectRatio = msoTrue
    Set rot = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 28, 28)
    rot.Fill.ForeColor.RGB = RGB(255, 0, 0)
    rot.LockAspectRatio = msoTrue
    Set gelb = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 130, 28, 28)
    gelb.Fill.ForeColor.RGB = RGB(255, 255, 0)
    gelb.LockAspectRatio = msoTrue
    Set green = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 160, 28, 28)
    green.Fill.ForeColor.RGB = RGB(0, 255, 0)
    green.LockAspectRatio = msoTrue
    ' # # # # # # # # P R O B L E M    # # # # # # # #
    ' Gruppierung Versuch 1
    ActiveSheet.Shapes.Range(Array("rah", "rot", "gelb", "green")).Group
    End Sub
    


  • Hier der vorläufige Code für das Umschalten der Ampel:
  • 
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address = "$JF$1" Then
    Select Case Range("JF1")
    Case 1 ' rot
    ActiveSheet.Shapes.Range(Array("rot")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("gelb")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("green")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    Case 2 ' gelb
    ActiveSheet.Shapes.Range(Array("rot")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("gelb")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 255, 0)
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("green")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    Case 3 ' grün
    ActiveSheet.Shapes.Range(Array("rot")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("gelb")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    ActiveSheet.Shapes.Range(Array("green")).Select
    With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(146, 208, 80)
    .Transparency = 0
    .Solid
    End With
    End Select
    End If
    Range("JF1").Select
    End Sub
    

  • 1
    Beitrag zum Forumthread
    Beitrag zu diesem Forumthread

    Betreff
    Datum
    Anwender
    • 15.11.2013 09:45:27
      Beverly
    Anzeige
    doppelt
    15.11.2013 09:45:27
    Beverly
    ...


    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige