ich sitze mal wieder an einem VBA-Problem, habe nichts brauchbares im inet gefunden ... daher die Bitte an Euch: Bitte helft mir doch noch mal !
-> Was soll das Makro tun?
Um einen Drehpunkt sollen x-y-Koordinaten rotiert werden (in einem bestimmtem Winkel).
-> Lösungsweg:
Mittels Inputbox frage ich die x-y-Koordinaten und Daten ab (Bediener gibt die Bereiche und Werte ein).
Die Koordinaten werden in Ein-Arrays aufgenommen, ein paar Plausi-Prüfungen durchgeführt und schließlich wird gerechnet. Die Ergebnisse sollen in Aus-Arrays gespeichert und ausgegeben werden.
-> Problem:
Die Ein-Arrays sind zwar gefüllt (UBound und LBound werden im Debugger richtig angezeigt), aber trotzdem kann während der Berechnung nicht darauf zugegriffen werden! Ich habe schon alles (mir mögliche) versucht. Z.B. mit ReDim Preserve, aber davon wird's auch nicht besser - funktioniert auch nicht: Ganz im Gegenteil, auf einmal unwillkürlich ganze Codeabschnitte übersprungen werden.
Ich hoffe, dass sich einer von den Profis erbarmt ...
Danke schon mal im Voraus, nachfolgend das Makro,
Martin
Sub PolygonRotation()
'rotierte Abbildung: x' = x0 + [(x-x0)*cos(w)] - [(y-y0)*sin(w)]
'rotierte Abbildung: y' = y0 + [(x-x0)*sin(w)] + [(y-y0)*cos(w)]
Const Pi As Single = 3.14159265358979
Dim i As Long
Dim UntArrEinGrz As Long
Dim ObeArrEinGrz As Long
Dim xEin As Variant '1D-Array
Dim yEin As Variant '1D-Array
Dim xAus As Variant '1D-Array
Dim yAus As Variant '1D-Array
Dim xDrehpunkt As Single, yDrehpunkt As Single
Dim WinkelGrad As Single, WinkelBogen As Single
'Bereich der Ausgangs-Koordinaten abfragen
xEin = Application.InputBox("Bereich der zu rotierenden x-Koordinaten", "Ausgangs-Koordinaten: _
Bereich wählen", , , , , , 64)
If VarType(xEin) = vbBoolean Then Exit Sub
yEin = Application.InputBox("Bereich der zu rotierenden y-Koordinaten", "Ausgangs-Koordinaten: _
Bereich wählen", , , , , , 64)
If VarType(yEin) = vbBoolean Then Exit Sub
'Plausibilitaetspruefung Ein-Koordinaten
If (UBound(xEin) - LBound(xEin)) (UBound(yEin) - LBound(yEin)) Then
MsgBox "Abbruch: Anzahl der x/y - Koordinaten waren ungleich !"
Exit Sub
End If
'Array-Grenzen zwischenspeichern
UntArrEinGrz = LBound(xEin)
ObeArrEinGrz = UBound(xEin)
'Redimensionieren der Ein-Arrays
'ReDim Preserve xEin(UntArrEinGrz To ObeArrEinGrz)
'ReDim Preserve yEin(UntArrEinGrz To ObeArrEinGrz)
'Drehpunkt-Koordinaten und Drehwinkel abfragen
xDrehpunkt = Application.InputBox("x-Koordinaten Drehpunkt", "Drehpunkt und -winkel", , , , , , _
1)
If VarType(xDrehpunkt) = vbBoolean Then Exit Sub
yDrehpunkt = Application.InputBox("y-Koordinaten Drehpunkt", "Drehpunkt und -winkel", , , , , , _
1)
If VarType(yDrehpunkt) = vbBoolean Then Exit Sub
WinkelGrad = Application.InputBox("Drehwinkel in Grad", "Bereich wählen", , , , , , 1)
If VarType(WinkelGrad) = vbBoolean Then Exit Sub
'Winkelumrechnung
WinkelBogen = WinkelGrad * Pi / 180
'Ausgabe-Arrays initialisieren
ReDim xAus(UntArrEinGrz To ObeArrEinGrz)
ReDim yAus(UntArrEinGrz To ObeArrEinGrz)
'Rotation: Berechnen der Koord.-AusArrays
For i = LBound(xEin) To UBound(xEin)
xAus(i) = xDrehpunkt + ((xEin(i) - xDrehpunkt) * Cos(WinkelBogen)) - ((yEin(i) - yDrehpunkt) _
* Sin(WinkelBogen))
yAus(i) = yDrehpunkt + ((xEin(i) - xDrehpunkt) * Sin(WinkelBogen)) + ((yEin(i) - yDrehpunkt) _
* Cos(WinkelBogen))
Next i
'Ausgabe der rotierten Koordinaten
For i = LBound(xEin) To UBound(xEin)
Cells(9 + i, 2) = xAus(i)
Cells(9 + i, 3) = yAus(i)
Next i
End Sub