Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
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

ActiveSheet.Shapes.AddLine einfärben / formatieren

ActiveSheet.Shapes.AddLine einfärben / formatieren
03.07.2014 13:17:32
Claus

Liebe Excelspezialisten,
mit folgendem Code zeichne ich eine Linie von einem Zellmittelpunkt zum anderen (Zellen variabel, x und y Koords je beginn und ende lbx, lby, lex, ley)
With Cells(xs, ys)
lbx = .Left + .Width / 2
lby = .Top + .Height / 2
End With
With Cells(xz, yz)
lex = .Left + .Width / 2
ley = .Top + .Height / 2
End With
ActiveSheet.Shapes.AddLine lbx, lby, lex, ley
Fragen:
Wie kann ich das erzeugte Objekt benennen, so dass ich es später gezielt ansprechen bzw. löschen kann?
Ich möchte die Farbe des Objekts ändern. Und zwar in die Farbe, die Zelle A1 als Hintergrundfarbe hat. Geht das?
Wie kann ich Anfangs- und Endgestaltung der Linie verändern? (Punkt oder Pfeilspitze)
Gibt es auch eine Funktion, die nur einen Punkt (dann natürlich nur mit lbx und lby) erzeugt?
Vielen Dank und liebe Grüße
Claus

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Probiere es mal...
03.07.2014 14:29:03
Case
Hallo, :-)
... so:
Dim shpLine As Shape
Set shpLine = ActiveSheet.Shapes.AddLine(lbx, lby, lex, ley)
With shpLine
.Name = "Test"
' Weitere Optionen
End With
Set shpLine = Nothing
Servus
Case

AW: Probiere es mal...
03.07.2014 15:34:52
Claus
Danke Case,
also den Namen zu vergeben geht, aber alle anderen Formatierungen bekomme ich so nicht hin. Ich glaube, dass die Syntax beim Aufzeichnen eine andere ist wie die hier, weil ich beim ausführen Fehler bekomme: Laufzeitfehler 438 Objekt unterstützt diese Eigenschaft oder Methode nicht.
Liebe Grüße
Claus

Anzeige
AW: Probiere es mal...
03.07.2014 18:40:46
fcs
Hallo Claus,
hier Beispiele, wie man Shapes formatieren kann.
Wenn man solche Funktionen öfter mal nutzen möchte oder mehrfach in der gleichen Datei, dann sollte man Subs erstellen, an die die Parameter (Start, Ziel, Farbe, etc) für die Erstellung übergeben werden.
Einen Punkt kann man als gefülltes Oval mit gleicher Höhe und Breite (=Durchmesser) darstellen.
Gruß
Franz
Sub MalenShapes()
With ActiveSheet
'Malen Linie01
Call MalenLinie(rngZelleS:=.Cells(2, 2), rngZelleZ:=.Cells(5, 4), _
strName:="Linie01", lngFarbe:=.Range("A1").Interior.Color)
'MalenPunkt01
Call MalenPunkt(rngZelle:=.Cells(2, 3), Diameter:=10, strName:="Punkt01", _
lngFarbe:=.Range("A1").Interior.Color)
End With
End Sub
Sub LoeschenShapes()
Call ShapeLoeschen("Linie01")
Call ShapeLoeschen("Punkt01")
End Sub
Sub MalenLinie(rngZelleS As Range, rngZelleZ As Range, strName, lngFarbe As Long, _
Optional dblWeight As Double = 2, _
Optional lngBeginArrowheadStyle As Long = 6, _
Optional lngEndArrowheadStyle As Long = 2, _
Optional lngArrowheadLength As Long = 3, _
Optional lngArrowheadWidth As Long = 3)
'Zeichnet eine Linie zwischen den Mittelpunkten zweier Zellen
'rngZelleS = Startzelle für Linie
'rngZelleZ = Zielzelle für Linie
'Arroheadstyles:
'1 = msoArrowheadNone
'2 = msoArrowheadTriangle
'3 = msoArrowheadOpen
'4 = msoArrowheadStealth
'5 = msoArrowheadDiamond
'6 = msoArrowheadOval
'-2 = msoArrowheadStyleMixed
'Arroheadlength:
'1 = msoArrowheadShort
'2 = msoArrowheadLengthMedium
'3 = msoArrowheadLong
'-2 = msoArrowheadLengthMixed
'ArroheadWidth:
'1 = msoArrowheadNarrow
'2 = msoArrowheadWidthMedium
'3 = msoArrowheadWide
'-2 = msoArrowheadWidthMixed
Dim objShape As Shape
Dim lbx, lby, lex, ley, xs, ys, xz, yz
On Error GoTo Fehler
With rngZelleS
lbx = .Left + .Width / 2
lby = .Top + .Height / 2
End With
With rngZelleZ
lex = .Left + .Width / 2
ley = .Top + .Height / 2
End With
Set objShape = ActiveSheet.Shapes.AddLine(lbx, lby, lex, ley)
With objShape
.Name = strName
With .Line
.ForeColor.RGB = lngFarbe
.Weight = dblWeight 'Linienbreite
'Startpunkt Line
.BeginArrowheadStyle = lngBeginArrowheadStyle
.BeginArrowheadLength = lngArrowheadLength
.BeginArrowheadWidth = lngArrowheadWidth
'Endpunkt Linie
.EndArrowheadStyle = lngEndArrowheadStyle
.EndArrowheadLength = lngArrowheadLength
.EndArrowheadWidth = lngArrowheadWidth
End With
End With
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Sub MalenPunkt(rngZelle As Range, Diameter, strName As String, lngFarbe As Long)
'Malt Punkt (Kreis) mit Durchmesser mitten in Zelle
Dim objShape As Shape
Dim lbx, lby
On Error GoTo Fehler
With rngZelle
lbx = .Left + .Width / 2 - Diameter / 2
lby = .Top + .Height / 2 - Diameter / 2
End With
Set objShape = ActiveSheet.Shapes.AddShape(msoShapeOval, lbx, lby, Diameter, Diameter)
With objShape
.Name = strName
With .Line
.ForeColor.RGB = lngFarbe
.Weight = 1 'Linienbreite
End With
With .Fill
.ForeColor.RGB = lngFarbe
End With
End With
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Sub ShapeLoeschen(strShape As String, Optional objSheet As Object)
On Error GoTo Fehler
If objSheet Is Nothing Then Set objSheet = ActiveSheet
objSheet.Shapes(strShape).Delete
Fehler:
With Err
Select Case .Number
Case 0
Case -2147024809 'Shape mit Name nicht gefunden
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: Probiere es mal...
04.07.2014 08:47:55
Claus
Hallo Franz,
super, vielen Dank hierfür. Jetzt komme ich echt weiter bei meiner Aufgabenstellung.
Genau so mache ich das, ich baue die gewünschten Dinge als Subs ein mit Übergabe der Parameter (Start, Ziel, Farbe, etc) für die Erstellung.
Hab jetzt noch nicht alles ausprobiert, aber die ersten beiden haben funktioniert, ich denke der Rest geht dann auch.
Liebe Grüße
Claus

90 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige