teste de position userform

[patricktoulon]

Bonjour a tous j'aurais besoins de vos retours sur la postion du userform
ces retours doivent s'accompagner de la version excel utilisé et la version de window
exemple chez moi emplacement B3 correcte , W7 , excel 2007
je vous remercie par avance pour le temps que vous prendrez pour ma petite experience
voici le code a tester
'--------------------------------------------------------------------------
Sub test20()
Dim pppx#, plus#, z#
With ActiveWindow.ActivePane
pppx = (.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - .PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width
L1 = (.PointsToScreenPixelsX([A1].Left) / pppx)
R1 = (.PointsToScreenPixelsY([A1].Top) / pppx)
End With
z = (ActiveWindow.Zoom / 100)
With UserForm1
.Show 0
plus = .Width - .InsideWidth
.Left = (L1 + [B3].Left + (plus / z)) * z
.Top = (R1 + [B3].Top + ((plus / 2) / z)) * z
End With
End Sub
'---------------------------------------------------------------------------

 

[patricktoulon]

@Rolland ton exemple fonction qu'en zoom 100 comme le mien des que l'on zoom ca deraille

 

[Nicolas JACQUIN]

Bonjour les amis,
Pour moi ce code fonctionne fonctionne au millimètre (Windows 10 et Excel 2016)
et avec n'importe quel zoom

Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Function PositionForm(Form As Object, rng As Range)
Dim K As Double, Z As Double

Z = ActiveWindow.Zoom / 100
K = GetDeviceCaps(GetDC(0), 88) / 72
K = GetDeviceCaps(GetDC(0), 90) / 72

lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 5
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
PositionForm = Array(lleft, ttop)

End Function

Sub TestUserform()
r = PositionForm(UserForm1, ActiveCell)
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

 

[Nicolas JACQUIN]

Et le voici sans API

Function PositionForm(FORM As Object, rng As Range)
Dim Z As Double, K As Double

Z = ActiveWindow.Zoom / 100
K = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Z

lleft = ActiveWindow.PointsToScreenPixelsX(rng.Left * K * Z) / K - 6
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
PositionForm = Array(lleft, ttop)

End Function

Sub TestUserform()
r = PositionForm(UserForm1, ActiveCell)
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

A bientôt

 

[Patrice33740]

@Nicolas Jacquin

Avec W10 32 bits et Excel 2007 ou Excel 2003, avec API, ça ne positionne pas correctement
Sans API, VBA plante sur ActiveWindow.ActivePane, en supprimant .ActivePane idem qu'avec API

 

[Patrice33740]

@patricktoulon

« avec ton exemple le userform tombe au milieu de la cellule a droite de celle qui est active »

Effectivement, cette exemple est prévu pour afficher le formulaire à 12 points du bord de la cellule à droite de la cellule active [i.e; offset(0 ,1)], dernière ligne du code :

  Me.Left = Lif + (dLs + cel.Offset(0, 1).Left) * fzF + 12

« tu ne prends pas en compte de DPI »

Pas besoin, chez moi ce code fonctionne correctement avec les 17 résolutions que mon écran accepte (de 800x600 à 1920x1080), il fonctionne aussi sur mes 2 autres PC (tous sous W10) c'est-àdire avec Excel 2007, 2010 et 2016.
Il y a juste petit problème de proportionnalité dans le sens vertical : en bas de feuille, le formulaire est légèrement plus haut que la cellule active, comme ça ne me gênait pas, je n'ai pas approfondi plus que ça.

Par contre, avec Excel 2003, il positionne le formulaire trop haut d'une demi cellule.

 

[Patrice33740]

Tu peux simplifier ton code :

Sub test20()
Dim pppx#, plus#, z#
With ActiveWindow.ActivePane
pppx = (.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - .PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width
L1 = (.PointsToScreenPixelsX(0) / pppx)
R1 = (.PointsToScreenPixelsY(0) / pppx)
End With
z = (ActiveWindow.Zoom / 100)
With UserForm1
.Show 0
plus = .Width - .InsideWidth
.Left = (L1 + [B3].Left) * z + plus
.Top = (R1 + [B3].Top) * z + plus / 2
End With
End Sub

 

[patricktoulon]

re et oui nicolas je ne voulais pas le montrer a cause de ca
en fait tout est une question de shell
xp ,vista,w7,w10 ont des dimensions différentes(cadre ,caption , inside,etc......)

patrice tu l'aura compris nous cherchons Nicolas et moi a faire une fonction générique valable pour toute configuration on est très proche mais pour cela il faut faire d'autre calcul que Nicolas ignore encore j'ai pas tout dis

 

[patricktoulon]

pour le moment ce code fonctionne avec W7,W10 et 2007,2010,2013,2016
Function PositionForm2(usf, rng)
Dim Zooom#, PtToPx#, cadre#, usable#
cadre = IIf(Application.OperatingSystem Like "*10*" And Val(Application.Version) <> 12, -5, 1)
With ActiveWindow
Zooom = .Zoom / 100
PtToPx = ((.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Zooom
lleft = (.PointsToScreenPixelsX(rng.Left * PtToPx * Zooom) / PtToPx) + cadre
ttop = .PointsToScreenPixelsY(rng.Top * PtToPx * Zooom) / PtToPx
End With
PositionForm2 = Array(lleft, ttop)
End Function


Sub TestUserformtopleftcell2()
r = PositionForm2(UserForm1, [B3])
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

 

[cathodique]

Bonjour la compagnie

Patrick chez moi w7 64bits excel 2010 32bits voici ce que j'obtiens

 

[MJ13]

Bonjour à tous

Tous ces codes sont intéressants, je n'en ai jamais vu autant sur XLD dans une discussion sur le thème du placement du userform.

Du coup je vous ai fait un petit fichier pour tester. Je n'ai retenu que 2 codes qui correspondent à mon besoin.

Merci à tous.

 

[patricktoulon]

re

et voila la version finale de W7 a 10 et excel 2007 a 2016 que nous avons mis au point Nicolas et moi
avec postion a la cellule et dans!! une plage de cellules

Function PositionForm2(usf, rng)
Dim Zooom#, PtToPx#, cadre#, system
system = Application.OperatingSystem
cadre = Application.Width - Application.UsableWidth
cadre = IIf(system Like "*10*" And Val(Application.Version) <> 12, -cadre / 2.4, cadre / 2.4)
With ActiveWindow
Zooom = .Zoom / 100
PtToPx = ((.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - .ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / Zooom
lleft = (.PointsToScreenPixelsX(rng.Left * PtToPx * Zooom) / PtToPx) + cadre
ttop = .PointsToScreenPixelsY(rng.Top * PtToPx * Zooom) / PtToPx + IIf(system Like "*6*", cadre, 0)

Wwidth = IIf(rng.Columns.Count > 1, rng.Width * (Zooom) - cadre * 2, usf.Width)
Hheight = IIf(rng.Rows.Count > 1, rng.Height * Zooom - cadre, usf.Height)
End With

PositionForm2 = Array(lleft, ttop, Wwidth, Hheight)

End Function
Sub TestUserformtopleftcell2()
r = PositionForm2(UserForm1, [b3])
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

Sub TestUserform2()
r = PositionForm2(UserForm1, ActiveCell)
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

Sub TestUserformDansPlage2()
r = PositionForm2(UserForm1, [B3:F12])
With UserForm1: .Show 0: .Left = r(0): .Top = r(1): .Width = r(2): .Height = r(3): End With
End Sub

 

[MJ13]

Merci Patrick pour ce code ultime.

Bon après, l'intérêt de mettre un fichier, c'est que les gens peuvent tester facilement.

 

[Roland_M]

Bonsoir à tous,

un grand merci pour ce travail !

Salut à toi MJ13, tu as tout à fait raison ! alors voici ...

 

[MJ13]

Bonjour Roland.

Merci pour le fichier, c'est cool, on reconnaît la marque des anciens (d'XLD , j'entend ).

 

[Roland_M]

re

à savoir qu'il reste un problème avec le scrolling et zoom !?

si par exemple on double clic sur la cellule F450
et qu'il y a un zoom de 130 l'userf se positionne en dessous !?
avec un zoom 140 il se positionne au dessus !?

et ça varie comme ça à chaque zoom différent !?

ça semble assez tordu pour solutionner ça !?