AW: ActiveX-Buttons bildschirmunabhängig positionieren?
07.03.2024 16:50:13
Eisi
Hallo Uwe,
ich habe Dein Lösungsansatz zum Anlass genommen, um mit ChatGPT in eine Diskussion zu gehen. Wir haben so hin und her diskutiert und folgender Vorschlag kam als Lösung raus. Die Lösung erscheint mir vielversprechend. Wollte ich Euch nicht vorenthalten.
Danke.
LG Eisi :-)
Private Sub Workbook_Open()
' Neue Position des Buttons berechnen und einstellen
NeuberechnenButtonPosition
End Sub
'
Private Sub Workbook_WindowResize(ByVal Wn As Window)
' Neue Position des Buttons berechnen und einstellen
NeuberechnenButtonPosition
End Sub
'
Private Sub NeuberechnenButtonPosition()
' Referenzwerte der Bildschirme
'
' Long = Ganzzahl
' Integer ist nicht mehr üblich und bringt auch keinen Speichervorteil.
' Double = Kommazahl
'
Const ReferenzBreite1 As Long = 732 'Mein Curve-Bildschirm
Const ReferenzHöhe1 As Long = 780 'Mein Curve-Bildschirm
Const ReferenzBreite2 As Long = 971 'Mein Laptop
Const ReferenzHöhe2 As Long = 521 'Mein Laptop
Const ReferenzBreite3 As Long = 1452 'Mein Bildschirm
Const ReferenzHöhe3 As Long = 792 'Mein Bildschirm
Const ReferenzBreite4 As Long = 700 'frei
Const ReferenzHöhe4 As Long = 400 'frei
' Aktuelle Bildschirmgröße abrufen
Dim aktuelleBreite As Long
Dim aktuelleHöhe As Long
aktuelleBreite = Application.Width
aktuelleHöhe = Application.Height
' Feststellen, welcher Bildschirm gerade die Voraussetzungen erfüllt
Select Case True
Case aktuelleBreite = ReferenzBreite1 And aktuelleHöhe = ReferenzHöhe1
' Mein Curve-Bildschirm
BerechneUndSetzeButtonPosition ReferenzBreite1, ReferenzHöhe1
Case aktuelleBreite = ReferenzBreite2 And aktuelleHöhe = ReferenzHöhe2
' Mein Laptop
BerechneUndSetzeButtonPosition ReferenzBreite2, ReferenzHöhe2
Case aktuelleBreite = ReferenzBreite3 And aktuelleHöhe = ReferenzHöhe3
' Mein Bildschirm
BerechneUndSetzeButtonPosition ReferenzBreite3, ReferenzHöhe3
Case aktuelleBreite = ReferenzBreite4 And aktuelleHöhe = ReferenzHöhe4
' Bildschirm 4
BerechneUndSetzeButtonPosition ReferenzBreite4, ReferenzHöhe4
Case Else
' Wenn keine Übereinstimmung gefunden wurde, nichts tun
Exit Sub
End Select
End Sub
Private Sub BerechneUndSetzeButtonPosition(ByVal ReferenzBreite As Integer, ByVal ReferenzHöhe As Integer)
' Horizontale und vertikale Skalierungsfaktoren berechnen
Dim horizontalerFaktor As Double
Dim vertikalerFaktor As Double
horizontalerFaktor = Application.Width / ReferenzBreite
vertikalerFaktor = Application.Height / ReferenzHöhe
' Neue Position der Buttons berechnen
'
' 2-Schichtplatten
' Button 1
Dim neueTopPosition_1 As Double 'Nummern anpassen!!
Dim neueLeftPosition_1 As Double 'Nummern anpassen!!
neueTopPosition_1 = 153.5833 * vertikalerFaktor ' Wert für den Button eintragen!!
neueLeftPosition_1 = 204.1666 * horizontalerFaktor ' Wert für den Button eintragen!!
With ThisWorkbook.Sheets("Kalkulation").Shapes("cmdPlattenUebertragen").TopLeftCell
.Top = neueTopPosition_1
.Left = neueLeftPosition_1
.Width = 120
.Height = 25.5
End With
'
'
' 3-Schichtplatten
' Button 2
Dim neueTopPosition_2 As Double 'Nummern anpassen!!
Dim neueLeftPosition_2 As Double 'Nummern anpassen!!
neueTopPosition_2 = 6873.833 * vertikalerFaktor ' Wert für den Button eintragen!!
neueLeftPosition_2 = 202.5 * horizontalerFaktor ' Wert für den Button eintragen!!
With ThisWorkbook.Sheets("Kalkulation").Shapes("cmdPlatten3Uebertragen").TopLeftCell
.Top = neueTopPosition_2
.Left = neueLeftPosition_2
.Width = 120
.Height = 25.5
End With
End Sub