VBA von Autoform Position ermitteln

Hallo Forum,
ich sollte evtl. eure Kenntnisse anzapfen mit folgendem Ansatz den ich gerne realisieren möchte.
Generell suche ich nach einer Lösung, eine Autoform ( Rechteck oder Textfeld ) sozusagen auszulesen bzgl. der Eigenschaftswerte ( Position ( Höhe - Breite ) und Länge ).
Ideal wäre eine Prozedur die klar erkennt - zunächst welche Autoform ausgewählt wird ... dann würde ich Sie von ihrer Position etwas verschieben, evtl auch mal rechts die Länge bestimmen - und wenn ich Sie verlasse ( indem ich zB. in eine Zelle klicke, oder eine andere Autoform auswähle, dann sollten die oben genannten Parameter sich in bestimmte Zellen schreiben.
Das man eine Autoform andersrum aus Zellwerten her beeinflussen kann ist mir klar, aber geht es auch eben andersrum ? Habt ihr ne Idee ?
AF. aus Zellen beeinflussen zB. so ...
ActiveSheet.Shapes.Range(Array("Rectangle 1")).IncrementLeft [A1].Value
ActiveSheet.Shapes.Range(Array("Rectangle 1")).IncrementTop [A2].Value
ActiveSheet.Shapes.Range(Array("Rectangle 1")).ScaleWidth [A3].Value, msoFalse, msoScaleFromMiddle
aber sozusagen vor Verlassen letzte Werte festhalten - aber wie, geht das überhaupt ?
Wäre für jede Idee empfänglich, schöne Grüße
Udo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Anbei eine Beispieldatei :
https://www.herber.de/bbs/user/125420.xlsm
Darin enthaltene Codes :
' ========================================================================================================================================


Function getObjPos(ObjName As String, Optional xPos As Boolean = True)
'       ======================================================================================== _
Application.ScreenUpdating = False
' returns position of shape for given shape name optional boolean parameter for x or y - _
position
' x-position is default
' 06-2006  E.Bimczok   Beitrag : https://microsoft.public.de.excel.narkive.com/sR9hFc7D/ _
autoformen-objektpositionierung-auslesen
Application.Volatile
Dim myObj As Object
'  Set a = ActiveSheet
For Each myObj In ActiveSheet.Shapes
If myObj.Name = ObjName Then
If xPos Then
getObjPos = myObj.Left
Else
getObjPos = myObj.Top
End If
Exit For
End If
Next myObj
Application.ScreenUpdating = True
End Function

' ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------


Sub verschieben()
'       ---------------------------------------------------------------------------------------- _
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Left = [B2].Value
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Top = [B3].Value
'        ActiveSheet.Shapes.Range(Array("Rectangle 1")).ScaleWidth = [B3].Value
End Sub


Sub ermitteln()
'       ---------------------------------------------------------------------------------------- _
[B2] = getObjPos("Rectangle 1")
[B3] = getObjPos("Rectangle 1", False)
End Sub


Sub Auswahl()
'       ---------------------------------------------------------------------------------------- _
Application.ScreenUpdating = False
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Application.ScreenUpdating = True
End Sub

LG udo

Function getObjPos(ObjName As String, Optional xPos As Long = 1) ' ======================================================================================== _ _ Application.ScreenUpdating = False ' returns position of shape for given shape name optional boolean parameter for x or y - _ _ position ' x-position is default ' 06-2006 E.Bimczok Beitrag : https://microsoft.public.de.excel.narkive.com/sR9hFc7D/ _ _ autoformen-objektpositionierung-auslesen Application.Volatile Dim myObj As Object ' Set a = ActiveSheet For Each myObj In ActiveSheet.Shapes If myObj.Name = ObjName Then If xPos = 1 Then getObjPos = myObj.Left ElseIf xPos = 2 Then getObjPos = myObj.Top Else getObjPos = myObj.Width End If Exit For End If Next myObj Application.ScreenUpdating = True End Function Sub ermitteln() [B2] = getObjPos("Rectangle 1") [B3] = getObjPos("Rectangle 1", 2) [B4] = getObjPos("Rectangle 1", 3) End Sub

Beliebteste Forumthreads (12 Monate)

VBA von Autoform Position ermitteln

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA von Autoform Position ermitteln

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread