teste de position userform

patricktoulon

XLDnaute Barbatruc
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
'---------------------------------------------------------------------------
 

Nico_J

XLDnaute Junior
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
 
Dernière édition:

Nico_J

XLDnaute Junior
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

XLDnaute Impliqué
@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 :
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

XLDnaute Impliqué
Tu peux simplifier ton code :
VB:
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Bonjour la compagnie:)

Patrick chez moi w7 64bits excel 2010 32bits voici ce que j'obtiens
Position Userform.JPG
 

MJ13

XLDnaute Barbatruc
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. ;)
 

Pièces jointes

  • Userform_Alignne_Cellule.xlsm
    33.1 KB · Affichages: 58

patricktoulon

XLDnaute Barbatruc
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
 

Roland_M

XLDnaute Barbatruc
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 !?
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 847
dernier inscrit
Djigbenou