Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
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:50:10
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
    

  • 11
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Warum 3 x ? und jeweils ohne Bsp-Workbook
    15.11.2013 09:03:26
    JoWE

    AW: Warum 3 x ? und jeweils ohne Bsp-Workbook
    15.11.2013 09:12:05
    Andi
    3x ohne jegliche Absicht. Bin mir Sicher, hier nur 1x auf den Sende-Button geklickt zu haben. Sorry. Bitte ggf. löschen.
    Eine Beispieldatei kann ich leider nicht online stellen. Zu viele "geheime Daten" und eine Befüllung mit Prosadaten wäre wahnsinnig aufwendig. Hoffe der betreffende Code zeigt meine Bauchschmerzen.

    AW: Objekte erstellen und gruppieren
    15.11.2013 09:25:28
    Beverly
    Hi Andi,
    wenn du die Shapes als Shape auf die Variablen schreibst, dann heißen sie ja nicht "rot", "grün" usw. sondern nach wie vor "Rechteck", "Oval" usw. Du musst also ihre Namen in dem Array verwenden:
      ActiveSheet.Shapes.Range(Array(rah.Name, rot.Name, gelb.Name, green.Name)).Group
    


    Anzeige
    AW: Objekte erstellen und gruppieren
    15.11.2013 09:38:17
    Andi
    Ok - das erklärt den Fehler. Danke!
    Aber es bringt mich dann wieder zum Anfang und die Variablen-Geschichte kann ich knicken.
    Denn Excel vergibt ja bei der Erstellung der Shapes immer wieder neue Namen (fortlaufende Nummern) und die kenne ich ja nicht :-(
    Kann ich die Namen trotzdem "einfangen" und in jedem Blatt individuell ansprechen?

    AW: Objekte erstellen und gruppieren
    15.11.2013 09:44:46
    Beverly
    Verstehe jetzt dein Problem nicht - die Shapes sind doch mit ihren Variablen definiert und die Namen (die sich ständig ändern) kannst du aus den Variablen - so wie in meiem geposteten Code - doch immer wieder ablesen, gleichgültig wie oft du den Code ausführst.


    Anzeige
    AW: Objekte erstellen und gruppieren
    15.11.2013 11:29:17
    Andi
    Uhhps! Und wieder fehlt mir das Fachwissen.
    Ich dachte, dass "NAME" ein Platzhalter ist und wusste nicht, dass es ebenso eine Art "automatische Variable" ist. ... dazugelernt!
    Und mit der Übergabe an eine weitere Variable (ampel) konnte ich auch LockAspectRatio wieder setzen, damit das Größenverhältnis bei Änderungen weiterhin passt.
    Besten DANK! Alles funktioniert.
    Set ampel = ActiveSheet.Shapes.Range(Array(rah.Name, rot.Name, gelb.Name, green.Name)).Group
    ampel.LockAspectRatio = msoTrue
    

    AW: Objekte erstellen und gruppieren
    15.11.2013 12:56:22
    Beverly
    Nimm einfach mal deine Variable rot (oder eine der anderen) in die Überwachung - dann kannst du dir im Überwachungsfenster alle Eigenschaften ansehen, welche diese Variable hat, so u.a. auch Name


    Anzeige
    AW: Objekte erstellen und gruppieren
    18.11.2013 13:21:41
    Andi
    Nochmals Hallo,
    nun habe ich es mit Unterstützung geschafft, dass bei der Kopie einer Vorlage auch zwei Ampeln erstellt und diese auch sofort gruppiert werden (letzteres für den User zum einfachen neu-positionieren auf dem Blatt, ohne die Shapes zu verschieben).
    Ziel sollte es auf jedem neuen Blatt sein, dass die Ampelfarben via Zelleingabe (o.Ä.) gesteuert werden sollen.
    Leider kann ich mit Hilfe des Codes im jeweiliegen Blatt nicht auf die urspr. Variablen zugreifen?
    Welchen Weg muss ich gehen?
    Eine angefertigte Datei: https://www.herber.de/bbs/user/88139.xlsm

    Anzeige
    AW: Objekte erstellen und gruppieren
    18.11.2013 14:26:05
    Beverly
    Gib den Shapes beim Erstellen einen Namen, dann kannst du auf diese Namen zurückgreifen:
    Dim rot As Shape
    Dim gelb As Shape
    Dim green As Shape
    Dim rah As Shape ' Rahmen
    Dim rot1 As Shape
    Dim gelb1 As Shape
    Dim green1 As Shape
    Dim rah1 As Shape ' Rahmen
    Dim ampel As Shape ' Gruppierung
    'Ampel 0
    Set rah = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 98, 98, 32, 92)
    rah.Fill.ForeColor.RGB = RGB(255, 255, 255)
    rah.LockAspectRatio = msoTrue
    rah.Name = "Rahmen1"
    Set rot = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 28, 28)
    rot.Fill.ForeColor.RGB = RGB(255, 0, 0)
    rot.LockAspectRatio = msoTrue
    rot.Name = "Rot"
    Set gelb = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 130, 28, 28)
    gelb.Fill.ForeColor.RGB = RGB(255, 255, 0)
    gelb.LockAspectRatio = msoTrue
    gelb.Name = "Gelb"
    Set green = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 160, 28, 28)
    green.Fill.ForeColor.RGB = RGB(0, 255, 0)
    green.LockAspectRatio = msoTrue
    green.Name = "Gruen"
    'Ampel 01
    Set rah1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 140, 98, 32, 92)
    rah1.Fill.ForeColor.RGB = RGB(255, 255, 255)
    rah1.LockAspectRatio = msoTrue
    rah1.Name = "Rahmen2"
    Set rot1 = ActiveSheet.Shapes.AddShape(msoShapeOval, 142, 100, 28, 28)
    rot1.Fill.ForeColor.RGB = RGB(255, 0, 0)
    rot1.LockAspectRatio = msoTrue
    rot1.Name = "Rot1"
    Set gelb1 = ActiveSheet.Shapes.AddShape(msoShapeOval, 142, 130, 28, 28)
    gelb1.Fill.ForeColor.RGB = RGB(255, 255, 0)
    gelb1.LockAspectRatio = msoTrue
    gelb1.Name = "Gelb1"
    Set green1 = ActiveSheet.Shapes.AddShape(msoShapeOval, 142, 160, 28, 28)
    green1.Fill.ForeColor.RGB = RGB(0, 255, 0)
    green1.LockAspectRatio = msoTrue
    green1.Name = "Gruen1"
    
    Und im Worksheet_Change-Ereignis dann diesen Code:
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address = "$A$1" Then
    'Farben _____________________________________________________________
    Select Case Range("A1")
    Case 1 ' rot
    With ActiveSheet.Shapes("Rot").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gelb").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gruen").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    Case 2 ' gelb
    With ActiveSheet.Shapes("Rot").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gelb").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 255, 0)
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gruen").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    Case 3 ' grün
    With ActiveSheet.Shapes("Rot").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gelb").Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gruen").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(146, 208, 80)
    .Transparency = 0
    .Solid
    End With
    Case 4 ' leer
    With ActiveSheet.Shapes("Rot").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gelb").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
    .Solid
    End With
    With ActiveSheet.Shapes("Gruen").Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
    .Solid
    End With
    End Select
    End If
    End Sub
    
    Man muss ein Element nicht selektieren, um es bearbeiten zu können.


    Anzeige
    Ampel: Objekte erstellen und gruppieren
    19.11.2013 16:45:09
    Andi
    Hallo Beverly / Karin,
    wiederholt Danke für die Aufklärung.
    Habe nun noch einiges angepasst und alle 6 Farbschaltungen in eigene "Sub's" geschrieben. Somit wunderbar aus dem Menü schaltbar.
    LG Andi

    Ampel: Objekte erstellen und gruppieren
    19.11.2013 16:45:20
    Andi
    Hallo Beverly / Karin,
    wiederholt Danke für die Aufklärung.
    Habe nun noch einiges angepasst und alle 6 Farbschaltungen in eigene "Sub's" geschrieben. Somit wunderbar aus dem Menü schaltbar.
    LG Andi

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige