Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
784to788
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
784to788
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Linie drehen lassen

Linie drehen lassen
21.07.2006 11:31:50
chris
Hallo Excel Experten,
habe eine frage on das möglich ist wenn ja wie.
Und zwar kann ich wenn ich in Excel eine Linie einfüge über die symbnolleiste zeichen diese Linie drehen lassen wie einen Uhrzeiger ? Also das eine ende soll fest stehen bleiben und sie soll sich um 360 grad drehen. im Sekundentakt.
wenn das möglich ist wäre ich über einen Tipp sehr dankebar.
gruß Christian

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Linie drehen lassen
21.07.2006 12:01:07
Matthias
Hallo Christian,
ein Ansatz "mit Hilfe der VBA-Hilfe":

Sub test()
Dim parr, i, x, y
Dim kn
For i = 1 To 100
parr = ActiveSheet.Shapes(1).Nodes(1).Points
x = parr(1, 1)
y = parr(1, 2)
ActiveSheet.Shapes(1).Nodes.SetPosition 1, x + 1, y + 1
Next i
End Sub

So geht also das Bewegen an sich, nun noch ein wenig Mathematik und es müsste klappen.
Gruß Matthias
AW: Linie drehen lassen
21.07.2006 12:21:37
Matthias
Hallo Chris,
hier noch dioe Mathematik:

Sub test()
Const Pi = 3.14159265358979
Dim parr, i, j, x As Double, y As Double, cx As Double, cy As Double, r As Double
Dim kn
Dim xarr(0 To 59) As Double
Dim yarr(0 To 59) As Double
Dim w As Integer
Dim ws As Double
parr = ActiveSheet.Shapes(1).Nodes(2).Points
'Zentrum ermitteln:
cx = parr(1, 1)
cy = parr(1, 2)
'Debug.Print cx, cy
'Punkt ermitteln:
parr = ActiveSheet.Shapes(1).Nodes(1).Points
x = parr(1, 1)
y = parr(1, 2)
'Abstand ermitteln:
r = Sqr((x - cx) * (x - cx) + (y - cy) * (y - cy))
Debug.Print r
'Punktarray mit 60 Koordinaten erstellen:
For w = 0 To 59
ws = w * (2 * Pi / 60) + Pi
xarr(w) = cx - Sin(ws) * r
yarr(w) = cy + Cos(ws) * r
Next w
'Kreisen lassen:
For i = 0 To 59
ActiveSheet.Shapes(1).Nodes.SetPosition 1, xarr(i), yarr(i)
Application.Wait Now + TimeValue("00:00:01")
Next i
End Sub

Gruß Matthias
Anzeige
AW: Linie drehen lassen
21.07.2006 17:24:06
chris
Hallo Matthias,
genau sowas habe ich gesucht.Ist wirklich super.Danke

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige