AW: geht bei mir auch unter xl2003 ...
18.07.2011 22:50:35
fcs
Hallo Gerhard, hallo Tino,
man kann die Formatierung der Linien/Pfeile auch im Code festlegen, dann geht es auch ohne Musterpfeile.
Leider ist der Makrorecorder unter Excel 2007 nicht so doll, so dass es etwas mühselig war, die Formatierungen zusammenzustellen.
Alles drum herum ist dann so wie in Tino's Lösung (Tastenbelegung für Strg+Pfeiltasten änder, wenn das Tabellenblatt aktiviert wird.)
Gruß
Franz
Code in Modul1:
Option Explicit
'Erstellt unter Excel 2007
'Code in allgemeinem Modul
Sub Aktiviere_Taste()
Application.OnKey "^{UP}", "'PfeilSetzen ""1""'"
Application.OnKey "^{DOWN}", "'PfeilSetzen ""2""'"
Application.OnKey "^{RIGHT}", "'PfeilSetzen ""3""'"
Application.OnKey "^{LEFT}", "'PfeilSetzen ""4""'"
End Sub
Sub DeAktiviere_Taste()
Application.OnKey "^{UP}"
Application.OnKey "^{DOWN}"
Application.OnKey "^{RIGHT}"
Application.OnKey "^{LEFT}"
End Sub
Public Sub Pfeilsetzen(lOption)
Select Case Val(lOption)
Case 1: Call EinfuegenPfeil(Zelle:=ActiveCell, lRichtung:=1, Farbe:=255) 'Pfeil oben - rot
Case 2: Call EinfuegenPfeil(Zelle:=ActiveCell, lRichtung:=2, Farbe:=6723891) 'Pfeil unten - _
grün
Case 3: Call EinfuegenPfeil(Zelle:=ActiveCell, lRichtung:=3, Farbe:=255) 'Pfeil rechts - _
rot
Case 4: Call EinfuegenPfeil(Zelle:=ActiveCell, lRichtung:=4, Farbe:=6723891) 'Pfeil links - _
grün
End Select
End Sub
Public Sub EinfuegenPfeil(Zelle As Range, lRichtung As Long, Farbe As Long)
Dim oPfeil As Shape, wks As Worksheet
Dim B_X#, B_Y#, E_X#, E_Y#, lFarbe As Long
Dim Laenge#
'Koordinaten der Linie, ermittelt aus Top- und Left-Position und Width der Zelle
'B_X = Beginn X
'E_X = Ende X
'B_Y = Beginn Y
'E_Y = Ende Y
With Zelle
Laenge = 16 'Länge der Pfeillinien
Select Case lRichtung
Case 1 'unten nach oben
B_X = .Left + .Width - 1: B_Y = .Top + .Height - 1
E_X = B_X: E_Y = B_Y - Laenge
Case 2 'oben nach unten
B_X = .Left + .Width - 1: B_Y = .Top + 1
E_X = B_X: E_Y = B_Y + Laenge
Case 3 'links nach rechts
B_X = .Left + .Width - 1 - Laenge: B_Y = Zelle.Top + .Height / 2
E_X = B_X + Laenge: E_Y = B_Y
Case 4 'rechts nach links
B_X = .Left + .Width - 1: B_Y = .Top + .Height / 2
E_X = B_X - Laenge: E_Y = B_Y
End Select
End With
Set wks = Zelle.Parent
Set oPfeil = wks.Shapes.AddLine(BeginX:=B_X, BeginY:=B_Y, EndX:=E_X, EndY:=E_Y)
With oPfeil
.Placement = xlMove 'Pfeil an Zelle gebunden
With .Line
'Form und Größe der Pfeile
.BeginArrowheadStyle = 1 'msoArrowheadNone
.EndArrowheadStyle = 2 'msoArrowheadTriangle
.EndArrowheadLength = 3 'msoArrowheadLong
.EndArrowheadWidth = 3 'msoArrowheadWide
.Weight = 1 'Linienbreite
'Farbe der Linie
.ForeColor.RGB = Farbe
End With
End With
Set wks = Nothing: Set oPfeil = Nothing
End Sub