Centrer un shape avec zoom

[Tiobi]

Bonjour,

Pour centrer un shape à l'écran j'utilise :

shp.Left = (Application.UsableWidth - shp.Width) / 2


Mais si j'applique un zoom de 140% par exemple, le shape n'est plus centré.



shp.Left = (Application.UsableWidth - (shp.Width * (ActiveWindow.Zoom / 100)) / 2) ne va pas bien. Si quelqu'un a une idée...

Merci

 

[PMO2]

Re : Centrer un shape avec zoom

Bonjour,

Une piste avec la démarche suivante

1) créez une feuille nommée test
2) y créer quelques Shapes disseminées
3) copiez le code suivant dans un module standard

'### Constante à adapter ###
Const MA_FEUILLE As String = "test"  'Adapter le nom de la feuille
'###########################

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Demo()
Dim S As Worksheet
Dim k&
Dim i&
Dim EtatWindow
EtatWindow = Array(xlNormal, xlMaximized)
On Error Resume Next
Set S = Sheets(MA_FEUILLE)
If Err <> 0 Then
  MsgBox "La feuille ''" & MA_FEUILLE & "'' est introuvable."
  Exit Sub
End If
On Error GoTo 0
S.Activate
For k& = LBound(EtatWindow) To UBound(EtatWindow)
  Application.WindowState = EtatWindow(k&)
  For i& = 50 To 200 Step 25
    Application.ScreenUpdating = False
    ActiveWindow.Zoom = i&
    [a1].Select
    Call CentrerHorizontalShapesAvecZoom(S)
    Call CentrerVerticalShapesAvecZoom(S)
    Application.ScreenUpdating = True
    DoEvents
    Sleep 400
  Next i&
Next k&
End Sub

Sub Direct()
Call CentrerHorizontalShapesAvecZoom(Sheets(MA_FEUILLE))
Call CentrerVerticalShapesAvecZoom(Sheets(MA_FEUILLE))
End Sub

Sub CentrerHorizontalShapesAvecZoom(S As Worksheet)
Dim SH As Shape
Dim WindowWidth As Double
WindowWidth = ActiveWindow.UsableWidth * (100 / ActiveWindow.Zoom) - 18
For Each SH In S.Shapes
  SH.Left = ((WindowWidth - SH.Width) / 2) - 1
Next SH
End Sub

Sub CentrerVerticalShapesAvecZoom(S As Worksheet)
Dim SH As Shape
Dim WindowHeight As Double
WindowHeight = ActiveWindow.UsableHeight * (100 / ActiveWindow.Zoom) - 18
For Each SH In S.Shapes
  SH.Top = ((WindowHeight - SH.Height) / 2) - 1
Next SH
End Sub

Le code qui vous intéresse est dans les Sub CentrerHorizontalShapesAvecZoom et Sub CentrerHorizontalShapesAvecZoom,
le reste n'est là que pour illustrer l'exemple.
Si vous appelez la Sub Direct, les Shapes de la feuille "test" sont centrées horizontalement et verticalement.

La Sub Demo simule l'état de la fenêtre Normale et Agrandie ainsi que différents Zooms variant de 50% à 200% par pas de 25%
avec une attente de 4 dixièmes de seconde pour pouvoir visualiser l'effet.

Cordialement.

PMO
Patrick Morange

 

[Tiobi]

Re : Centrer un shape avec zoom

Merci pour cette proposition qui permet de centrer parfaitement le shape dans le sens horizontal.

Je souhaite également center le shape de manière verticale tout en appliquent un facteur de zoom.

Je pense que je vais essayer de me caler sur les propiétés height et width du range visible a l'écran.

Pas tout a fait trouvé, mais j'y suis presque.

Encore Merci pour votre aide.

Bonne soirée.

 

[PMO2]

Re : Centrer un shape avec zoom

Bonjour,

J'ai modifié mon message précédent suite à la demande de centrer les Shapes verticalement.

Le code y figurant ainsi que la pièce jointe prennent maintenant en compte les 2 types de centrage (le centrage horizontal et le centrage vertical).

Cordialement.

PMO
Patrick Morange