VBA-Grafik-Programmierung  →   ohne Beispiele  
   
Befehl Beschreibung
ActiveSheet.DrawingObjects.Delete Alle Grafik-Objekte löschen
ActiveSheet.DrawingObjects.Delete
ActiveSheet.Shapes(<Nr>).Delete
ActiveSheet.Shapes(<Name>).Delete		 Bestimmtes Grafik-Objekt löschen
 
siehe unten, unter Polylinie
ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Name = <Name> Linie zeichnen
Sub Linie(Objekt, Name, X1, Y1, X2, Y2)
    '+--------------------------+
    '|  Zeichnen einer Geraden  |
    '+--------------------------+
    On Error Resume Next
       Objekt.Shapes(Name).Delete  ' Objekt löschen, falls bereits vorhanden
    On Error GoTo 0
    Objekt.Shapes.AddLine(X1, Y1, X2, Y2).Name = Name
End Sub
ActiveSheet.Shapes(<Name>).Line.BeginArrowheadLength
ActiveSheet.Shapes(<Name>).Line.BeginArrowheadWidth
ActiveSheet.Shapes(<Name>).Line.BeginArrowheadStyle		 Linienpfeile zeichnen
Sub Pfeiltypen()
    Dim Name        As String
    Dim Nr          As Integer

    Dim L(1 To 4)   As Integer        ' Pfeilspitzenlänge
    Dim B(1 To 4)   As Integer        ' Pfeilspitzenbreite
    Dim S(1 To 7)   As Integer        ' Pfeilspitzenstil

    L(1) = msoArrowheadLengthMixed    ' -2
    L(2) = msoArrowheadShort          '  1
    L(3) = msoArrowheadLengthMedium   '  2
    L(4) = msoArrowheadLong           '  3

    B(1) = msoArrowheadWidthMixed     ' -2
    B(2) = msoArrowheadNarrow         '  1
    B(3) = msoArrowheadWidthMedium    '  2
    B(4) = msoArrowheadWide           '  3

    S(1) = msoArrowheadStyleMixed     ' -2
    S(2) = msoArrowheadNone           '  1
    S(3) = msoArrowheadTriangle       '  2
    S(4) = msoArrowheadOpen           '  3
    S(5) = msoArrowheadStealth        '  4
    S(6) = msoArrowheadDiamond        '  5
    S(7) = msoArrowheadOval           '  6

    On Error Resume Next
       For Nr = 1 To 4
           Name = "Linie1" & Nr
           ActiveSheet.Shapes(Name).Delete
           ActiveSheet.Shapes.AddLine(200 + 50 * Nr, 100, 200 + 50 * Nr, 150).Name = Name
           ActiveSheet.Shapes(Name).Line.BeginArrowheadLength = L(Nr)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadWidth  = B(2)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadStyle  = S(5)
       Next Nr
       For Nr = 1 To 4
           Name = "Linie2" & Nr
           ActiveSheet.Shapes(Name).Delete
           ActiveSheet.Shapes.AddLine(200 + 50 * Nr, 200, 200 + 50 * Nr, 250).Name = Name
           ActiveSheet.Shapes(Name).Line.BeginArrowheadLength = L(4)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadWidth  = B(Nr)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadStyle  = S(5)
       Next Nr
       For Nr = 1 To 7
           Name = "Linie3" & Nr
           ActiveSheet.Shapes(Name).Delete
           ActiveSheet.Shapes.AddLine(200 + 50 * Nr, 300, 200 + 50 * Nr, 350).Name = Name
           ActiveSheet.Shapes(Name).Line.BeginArrowheadLength = L(4)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadWidth  = B(4)
           ActiveSheet.Shapes(Name).Line.BeginArrowheadStyle  = S(Nr)
       Next Nr
    On Error GoTo 0
End Sub
ActiveSheet.Shapes.AddPolyline(XY).Name = Name Polylinie zeichnen
Sub PolylinieZeichnen()
    Dim Nr                   As Integer
    Dim XY(1 To 100, 1 To 2) As Single

    For Nr = 1 To 100
        XY(Nr, 1) = Rnd * 300 + 100
        XY(Nr, 2) = Rnd * 300 + 100
    Next Nr
    On Error Resume Next
       ActiveSheet.Shapes("TestLinie").Delete
    On Error GoTo 0
    ActiveSheet.Shapes.AddPolyline(XY).Name = "TestLinie"
End Sub
ActiveSheet.Shapes(<Name>).Nodes.Count Anzahl Polylinie-Punkte ermitteln
Msgbox ActiveSheet.Shapes("Linie").Nodes.Count
ActiveSheet.Shapes(<Name>).Nodes(<Nummer>).Point Polylinie-Punkt lesen
Sub PunktkoordinatenErmitteln(Name, XY)
    Dim AzPunkte As Integer
    Dim EinzelPunkt As Variant
    Dim GrafikObjekt As Shape
    Dim Punkt As Integer

    Set GrafikObjekt = ActiveSheet.Shapes(Name)
    AzPunkte = GrafikObjekt.Nodes.Count
    ReDim XY(1 To AzPunkte, 1 To 2) As Single
    For Punkt = 1 To AzPunkte
        EinzelPunkt = GrafikObjekt.Nodes(Punkt).Points
        XY(Punkt, 1) = EinzelPunkt(1, 1)
        XY(Punkt, 2) = EinzelPunkt(1, 2)
    Next Punkt
End Sub
ActiveSheet.Shapes("PolyLinie").Nodes.Delete <Punkt-Nummer> Polylinie-Punkt löschen
Sub LinienPunktLöschen()
    Dim Linie As Shape

    Set Linie = ActiveSheet.Shapes("PolyLinie")
    Linie.Nodes.Delete 4
End Sub
ActiveSheet.Shapes.AddShape(msoShapeRectangle, X1, Y1, Breite, Höhe).Name = <Name> Rechteck zeichnen
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 100, 200, 200).Name = "Rechteck"
ActiveSheet.Shapes.AddShape(msoShapeOval, X, Y, Breite, Höhe).Name = <Name> Ellipse zeichnen
Sub Kreis(X0, Y0, R, Name)
    '+-------------------------------------------------+
    '| Zeichnen eines Kreises                          |
    '+-------------------------------------------------+
    '| X0 / Y0 = Koordinaten des Kreis-Mittelpunktes   |
    '|       R = Kreis-Radius                          |
    '|    Name = Name des Kreises                      |
    '+-------------------------------------------------+
    On Error Resume Next
       ActiveSheet.Shapes(Name).Delete
    On Error GoTo 0
    ActiveSheet.Shapes.AddShape(msoShapeOval, X0 - R, Y0 - R, 2 * R, 2 * R).Name = Name
End Sub
ActiveSheet.Shapes(<Name>).Visible = True / False Grafikobjekt sichtbar / unsichtbar schalten
ActiveSheet.Shapes("Kreis").Visible= False
ActiveSheet.Shapes(<Name>).Left = <Abstandswert> Abstande des Grafikobjektes vom linken Rand des Tabellenblattes
ActiveSheet.Shapes("Kreis").Left = 100
ActiveSheet.Shapes(<Name>).Top = <Abstandswert> Abstande des Grafikobjektes vom oberen Rand des Tabellenblattes
ActiveSheet.Shapes("Kreis").Top = 100
ActiveSheet.Shapes(<Name>).Width = <Wert> Breite des Grafikobjektes
ActiveSheet.Shapes("Kreis").Width = 100
ActiveSheet.Shapes(<Name>).Height = <Wert> Höhe des Grafikobjektes
ActiveSheet.Shapes("Figur").Height = 52
ActiveSheet.Shapes(<Name>).Rotation = <Altgrad-Winkel> Drehung des Grafikobjektes im Uhrzeigersinn ( in Altgrad )
ActiveSheet.Shapes(<Name>).Rotation = <Altgrad-Winkel>
ActiveSheet.Shapes(<Name>).Fill.Visible = True / False Füllung sichtbar / unsichtbar schalten
ActiveSheet.Shapes("Figur").Fill.Visible = True
ActiveSheet.Shapes(<Name>).Fill.Solid Gleichmäßige Füllung
ActiveSheet.Shapes("Figur").Fill.Solid
ActiveSheet.Shapes(<Name>).Fill.ForeColor.RGB = RGB(Rot, Grün, Blau) Füllfarbe setzen
ActiveSheet.Shapes("Figur").Fill.ForeColor.RGB = RGB(255, 0, 0)   ' Füllfarbe auf rot setzen
ActiveSheet.Shapes("Figur")Fill.TwoColorGradient <Richtung>, <Modus> Farbverlauf
Sub FüllVerlauf(Objektname, Rot1, Grün1, Blau1, Rot2, Grün2, Blau2, Richtung, Modus)
    '+-----------------------------------------------------------------------+
    '|  Objektname           = Name des Grafikobjektes                       |
    '|  Rot1 / Grün1 / Blau1 = Farbanteile für die Vordergrundfarbe ( VGF )  |
    '|  Rot2 / Grün2 / Blau2 = Farbanteile für die Hintergrundfarbe ( HGF )  |
    '|  Richtung             = Farbverlaufrichtung:                          |
    '|                         msoGradientHorizontal    ( 1 )                |
    '|                         msoGradientVertical      ( 2 )                |
    '|                         msoGradientDiagonalUp    ( 3 )                |
    '|                         msoGradientDiagonalDown  ( 4 )                |
    '|                         msoGradientFromCorner    ( 5 )                |
    '|                         msoGradientFromTitle     ( 6 )                |
    '|                         msoGradientFromCenter    ( 7 )                |
    '|  Modus                = Farbverlaufsfolge:                            |
    '|                         1 = VGF -> HGF                                |
    '|                         2 = HGF -> VGF                                |
    '|                         3 = VGF -> HGF -> VGF                         |
    '|                         4 = HGF -> VGF -> HGF                         |
    '+-----------------------------------------------------------------------+
    With ActiveSheet.Shapes(Objektname)
        .Fill.ForeColor.RGB = RGB(Rot1, Grün1, Blau1)
        .Fill.BackColor.RGB = RGB(Rot2, Grün2, Blau2)
        .Fill.TwoColorGradient Richtung, Modus
    End With
End Sub

Sub Aufruf()
    FüllVerlauf "RECHTECK", 255, 0, 0, 0, 0, 255, msoGradientDiagonalUp, 2
End Sub
ActiveSheet.Shapes(<Name>).Fill.Transparency = Wert ( 0..1 ) Transparents des Grafikobjektes setzen
ActiveSheet.Shapes("Figur").Fill.Transparency = 0.5
ActiveSheet.Shapes(<Name>).Line.ForeColor.RGB = RGB(Rot, Grün, Blau) Linienfarbe setzen
ActiveSheet.Shapes("Figur").Line.ForeColor.RGB = RGB(0, 0, 255)   ' Linienfarbe auf blau setzen
ActiveSheet.Shapes(<Name>).Line.Weight = <Dicke> Liniendicke setzen
ActiveSheet.Shapes("Figur").Line.Weight = 1
ActiveSheet.Shapes(<Name>).Type Grafiiktyp ermitteln
MsgBox ActiveSheet.Shapes("Figur").Type
ActiveSheet.Shapes(<Name>).TextFrame.Characters.Text = <Text> Text in Grafikobjekt einfügen ( auch Textbox )
ActiveSheet.Shapes("Figur").TextFrame.Characters.Text = "Berechnungen"
ActiveSheet.Shapes(<Name>).TextFrame.Characters.Font.Size = <Größe> Textgröße des Grafikobjektes
ActiveSheet.Shapes("Figur").TextFrame.Characters.Font.Size = 20
.Shapes(<Name>).TextFrame.Characters.Font.Color = RGB(Rot, Grün, Blau) Textfarbe des Grafikobjektes setzen
ActiveSheet.Shapes("Figur").TextFrame.Characters.Font.Color = RGB(0, 0, 255)   ' Textfarbe auf blau setzen.
.Shapes(<Name>).TextFrame.Characters.Font.Name = <Schriftname> Schriftname des Textes eines Grafikobjektes
ActiveSheet.Shapes("Figur").TextFrame.Characters.Font.Name = "Arial"
.Shapes(<Name>).TextFrame.Characters.Font.FontStyle = <StyleName>
                                                      		Schriftart des Textes eines Grafikobjektes
( "Standard" / "Fett" / "Kursiv" / "Fett Kursiv" )
ActiveSheet.Shapes("Figur").TextFrame.Characters.Font.FontStyle = "Fett"
ActiveSheet.Shapes(<Name>).TextFrame.HorizontalAlignment = <Ausrichtung> Text in Grafikobjekt horizontal ausrichten
( xlRight, xlLeft, xlCenter )
ActiveSheet.Shapes("Figur").TextFrame.HorizontalAlignment = xlCenter
ActiveSheet.Shapes(<Name>).TextFrame.VerticalAlignment = <Ausrichtung> Text in Grafikobjekt vertikal ausrichten
( xlTop, xlBottom, xlCenter )
ActiveSheet.Shapes("Figur").TextFrame.VerticalAlignment = xlCenter
ActiveSheet.Shapes.AddTextbox Textbox erstellen
Sub TextboxErstellen(Objekt, Name, X, Y, Text, Optional Rahmen, _
                                               Optional Hintergrund, _
                                               Optional R, _
                                               Optional G, _
                                               Optional B)
'+--------------------------------------------------------+
'|  Erstellt eine Textbox und schreibt einen Text hinein  |
'+--------------------------------------------------------+
    On Error Resume Next
       ActiveSheet.Shapes(Name).Delete
    On Error GoTo 0
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, 50, 50).Name = Name
    ActiveSheet.Shapes(Name).TextFrame.AutoSize = True
    ActiveSheet.Shapes(Name).TextFrame.Characters.Text = Text
    ActiveSheet.Shapes(Name).Left = X - ActiveSheet.Shapes(Name).Width / 2
    ActiveSheet.Shapes(Name).Top = Y - ActiveSheet.Shapes(Name).Height / 2
    ActiveSheet.Shapes(Name).Line.Visible = Not IsMissing(Rahmen)

    ActiveSheet.Shapes(Name).Fill.Visible = msoFalse
    If IsMissing(Rahmen) = False Then
       ActiveSheet.Shapes(Name).Line.Visible = Rahmen
    Else
       ActiveSheet.Shapes(Name).Line.Visible = msoFalse
    End If

    If IsMissing(Hintergrund) = False Then
       ActiveSheet.Shapes(Name).Fill.Visible = msoTrue
       ActiveSheet.Shapes(Name).Fill.ForeColor.RGB = RGB(R, G, B)
    Else
       ActiveSheet.Shapes(Name).Fill.Visible = msoFalse
    End If
End Sub
ActiveSheet.Shapes(<Objektname>).Copy
ActiveSheet.Paste		 Grafikobjekt kopieren
Sub GrafikObjektKopieren()
    Sheets("Tabelle2").Select
    ActiveSheet.Shapes("Text Box 1").Copy

    Sheets("Tabelle1").Select
    Range("F9").Select
    ActiveSheet.Paste
    Selection.Name = "Test"
End Sub
ActiveSheet.Shapes(<Objektname>).PickUp
ActiveSheet.Shapes(<Objektname>).Apply		 Formatübertrag Grafikobjekt
Sub FormatÜbertragEinfach()
    ActiveSheet.Shapes(1).PickUp
    ActiveSheet.Shapes(2).Apply
End Sub

 Sub FormatÜbertragVielfachSchleife()
    Dim Nr As Integer

    For Nr = 1 To 5
        ActiveSheet.Shapes(6).PickUp
        ActiveSheet.Shapes(Nr).Apply
    Next Nr
End Sub

Sub FormatÜbertragVielfachIndex()
    ActiveSheet.Shapes(6).PickUp
    ActiveSheet.Shapes.Range(Array(1, 2, 3, 4, 5)).Apply
End Sub

Sub FormatÜbertragVielfachName()
    ActiveSheet.Shapes(6).ShapeRange.PickUp
    ActiveSheet.Shapes.Range(Array("Text Box 1", "Text Box 2", "Text Box 3", "Text Box 4", "Text Box 5")).Apply
End Sub
ActiveSheet.Shapes(<ObjektName>).SetShapesDefaultProperties Formate eines Grafikobjektes als Standard setzen
Sub GrafikObjektStandard_Start()
    GrafikObjektAlsStandard "Rectangle 2"
End Sub

Sub GrafikObjektAlsStandard(Name)
    ActiveSheet.Shapes(Name).SetShapesDefaultProperties
End Sub