Textfeld ansprechen
05.01.2005 15:38:00
Toni
Ich erstelle in einem Programm Textfelder(aus Zeichnen)mit Rahmen per Knopfdruck.
Diese Textfelder stellen Gebäude dar, die eine bestimmte Länge, Breite und Bezeichnung haben. Das ganze ergibt einmal einen Lageplan.
Das klappt soweit ganz gut.
Nun möchte ich noch erreichen, dass der Anwender das Gebäude (Textfeld) um 90 Grad drehen kann. Da dies mit Excel/Zeichnen-Mitteln wohl nicht möglich ist, möchte ich einfach Länge und Breite des Textfeldes (per VBA) vertauschen.
Der Anwender muss zunächst ein Textfeld markieren und soll dann über einen Button das Textfeld kippen.
Hier beginnen meine Schwierigkeiten:
Wie erkennt VBA das aktivierte Textfeld?
Gibt es sowas wie 'ActiveShape'?
Wie lese ich aus dem aktivierten Textfeld Länge und Breite aus und wie vertausche ich diese am besten?
Hier der Code, mit dem ich die Textfelder erstelle:
Private Sub cmdSkizzeStart_Click()
Dim multiL As Single
Dim multiB As Single
Dim anzGebAntrag As Integer
Dim mark1 As Single
Dim mark2 As Single
anzGebAntrag = Worksheets("Kundendaten").Range("B317").Value + _
Worksheets("Kundendaten").Range("B318").Value + _
Worksheets("Kundendaten").Range("B319").Value
ActiveSheet.Unprotect
mark1 = 145
mark2 = 2780
For i = 1 To anzGebAntrag
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, mark1, mark2, _
50, 50).Select
multiL = Worksheets("WEGebaeude").Range("D" & 6 + i).Value / 10
multiB = Worksheets("WEGebaeude").Range("E" & 6 + i).Value / 10
With Selection
.ShapeRange.ScaleHeight multiL, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleWidth multiB, msoFalse, msoScaleFromTopLeft
.ShapeRange.Fill.Visible = msoTrue
.Characters.Text = Worksheets("WEGebaeude").Range("B" & 6 + i) & Chr(10) & "BAK " & _
Worksheets("WEGebaeude").Range("I" & 6 + i) & Chr(10) & _
Worksheets("WEGebaeude").Range("C" & 6 + i)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 6
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
mark1 = mark1 + 10
mark2 = mark2 + 10
Next i
ActiveSheet.Protect DrawingObjects:=False
End Sub
Hat vielleicht jemand eine Idee ?
Ciao
Toni
Anzeige