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

 

[MJ13]

Re Roland

Bon, après il faut voir dans quel cas cela bug, mais avec tous les codes dispos ici, on pourra facilement trouver une solution.

 

[patricktoulon]

Bonsoir a tous
travaillant en collaboration avec Nicolas sur un autre forum aussi
on avance sur la distinction des soucis de divergence selon les versions
en effet plusieurs soucis sont venus se greffer notamment l'utilisation de la variable "cadre" utilisant le calcul du width-usablewidth de l'application qui s'avere malheureusement non concluant car le shell de Windows selon la version Windows et office n’affiche pas les même paramètres
nous travaillons donc sur un switch
comme j'ai cru comprendre qu'un fichier serait le bien venu je vais vous en faire un avec position dynamique ajustement avec des boutons les retours sur ces ajustement avec versions windows et office me seront très utile pour finaliser le projet

je cite une remarque
'__________________________________________
à savoir qu'il reste un problème avec le scrolling et zoom !?
___________________________________________

réponse:
je rappelle justement que la version ultime n'a plus besoins de prendre en compte les scrollbars de l'application

 

[patricktoulon]

nous y voila
j'ai repris le fichier de Roland
j'ai changé la fonction et mis celle qui sera définitive
vous verre dans le code un switch ce swicth sera instruit par vos retours
alors toujours pareil douclick sur cellule
le userform doit prendre la plage qui est inscrite en haut a gauche dans le textbox Blanc
vous avez des boutons (-/+) pour les left,top,width,height pour ajuster
ce que j'aimerais si ca ne vous dérange pas trop c'est que vous ajustiez et vous me doniez le retour du textbox jaune ainsi que votre version de window et office
exemple pour moi le retour est
W 7 office 2007 config=18 , array(3,2,-8,-6)

 

[Roland_M]

re bonjour à tous,

salut Patrick,
je pense qu'il ne faut pas chercher à redimensionner l'userform, pour moi c'est d'aucun intérêt
et puis si on fait ça sur 4 petites cellules on n'a plus rien !?
seul compte la position Top Left !
d'autant plus qu'il faudrait redimensionner l'userf et aussi les contrôles,
pour cela il y a des routines spécifiques en rapport à la résolution.

car avec un zoom plus petit, déjà à 100, chez moi le contrôle Height n'est plus visible !?

sinon perso j'ai la même config que toi ! Win 7 et Office 2007 et le même résultat !
excepté que je n'utilise pas le redimensionnement de l'userf

 

[Patrice33740]

Voilà :
avec W10 Office 2007

 

[Roland_M]

re

si je puis me permettre, il faudrait préciser avec quel zoom feuille !?

bizarre le no de version win = 6 pour Win7 et Win10 !?


EDIT:
par-contre je comprends pas Cadre( ), tel que programmé là,
Cadre(0) Cadre(1) ... seront toujours = 0 !?

et concernant une position de ligne plus basse, par exemple Ligne 800,
on a toujours le même problème dès qu'on utilise un zoom <> 100 !?

 

[Dranreb]

Bonjour.
Information :
Personnellement je munis de cette méthode les UserForm que je veux pouvoir positionner :

Public Sub Posit(ByVal O As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
Rem. ——— Vous pouvez au préalable positionner l'UserForm par rapport à quelque chose.
'     O: Ce par rapport à quoi vous voulez le positionner. X et Y indiqueront comment :
'     X: -1: Collé au coté gauche, 0: Centré horizontalement, 1: Collé au coté droit.
'     Y: -1: Collé au bord supérieur, 0: Centré verticalement, 1: Collé juste en dessous.
'     D'autres valeurs entraineront un recouvrement partiel ou un certain éloignement.
'     Mais rien ne vous empêche de rectifier encore ensuite la propriété Left ou Top
'     de l'UFmCalend pour ajouter un interstice en points au bord de l'objet. Mais toujours
'     avant le Show, donc avant utilisation de la méthode Saisie.
Dim G As Double, D As Double, H As Double, B As Double, U As Object, K As Double, Z As Double
If TypeOf O Is MSForms.Control Then
   G = O.Left: H = O.Top: Set U = O.Parent
   Do: K = (U.Width - U.InsideWidth) / 2
      G = G + U.Left + K: H = H + U.Top + U.Height - U.InsideHeight - K
      If Not TypeOf U Is MSForms.Frame Then Exit Do
      Set U = U.Parent: Loop
   D = G + O.Width: B = H + O.Height
Else
   Z = ActiveWindow.Zoom / 100
   K = GetDeviceCaps(GetDC(0), 88) / 72
   G = ActiveWindow.PointsToScreenPixelsX(O.Left * K * Z) / K
   D = ActiveWindow.PointsToScreenPixelsX((O.Left + O.Width) * K * Z) / K
   K = GetDeviceCaps(GetDC(0), 90) / 72
   H = ActiveWindow.PointsToScreenPixelsY(O.Top * K * Z) / K
   B = ActiveWindow.PointsToScreenPixelsY((O.Top + O.Height) * K * Z) / K
   End If
Me.Left = (X * (D - G + Me.Width + 6) + G + D - Me.Width - 6) / 2 + 3
Me.Top = (Y * (B - H + Me.Height + 6) + H + B - Me.Height - 6) / 2 + 3
End Sub

Utilise :

Private Declare Function GetDC& Lib "user32.dll" (ByVal hWnd&)
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)

 

[Patrice33740]

avec zoom 100%

 

[patricktoulon]

bonsoir a tous
patrice w10 et 2007 je sais c'est 0 partout par contre ca n'est pas config 18 mais 22
version windows=10 +version office 2007=12 donc 22 c'est bizarre que ca mette config 18 dans le textbox jaune

quand au propositions d'apis je les connais pratiquement toute et le but dans cet exercice est justement de se passer des apis
w10 2007 j'ai
w10 2010 manque
w7 2007 j'ai
w7 2010 manque
w7 2013 manque
w10 2016 j'ai
w10 2013 manque

et toute les versions 64 bits Windows et office

Roland
non cadre est l'array pour le left,top,width,height
pour certain oui visiblement il n'y a pas besoins de rattrapage donc 0 effectivement

 

[Patrice33740]

Bonjour Patrick,

« patrice w10 et 2007 je sais c'est 0 partout par contre ca n'est pas config 18 mais 22
version Windows=10 +version office 2007=12 donc 22 c'est bizarre que ca mette config 18 dans le textbox jaune »
C'est bien W10 32 bits Famille V 1607 + Office 2007 SP3 MSO
Mais j'ai aussi Excel 2003 installé sur le même PC

Edit : Application.OperatingSystem = "Windows (32-bit) NT 6.02"

 

[Dranreb]

Bonsoir.
Je suppose qu'on peut se passer des API en les utilisant une 1ère fois, puis en prenant note de la valeur K donnée par GetDeviceCaps(GetDC(0), 88) / 72 et GetDeviceCaps(GetDC(0), 90) / 72 et en remplaçant K par cette valeur dans les instructions qui suivent.
Mais je ne sais pas si après ça ça fonctionnera sur tous les systèmes. Disons qu'en principe non, mais en pratique peut être… Ce n'est d'ailleurs peut être pas une question de système mais plutôt de matériel … (?)

 

[patricktoulon]

et oui j'ai aussi Nicolas qui fait cohabiter 2 version d'excel sur w10
2016 et 2013 pour être exact et malheureusement je lui ai dis a lui je te le dis le fait installer 2 versions l'une et l'autre fonctionne avec les même Common ,(clisd(base de registre)) et même certaine DLL mais qui ne sont pas les sienne a la base
total certaine fonctions sont carrément inutilisables car donnent des retours même curieux des fois
d'ailleurs les versions 6.2xxxx sont les windows 8 et 8.1

 

[patricktoulon]

danreb
pourquoi utiliser GetDeviceCaps(GetDC(0), 88) / 72 ou GetDeviceCaps(GetDC(0), 90) / 72

QUAND CECI
(activewindow.activepane.pointstoscreenpixelsx(3)-activewindow.activepane.pointstoscreenpixelsx(0))/3

te donne la même chose

tu qu'a tester

 

[Patrice33740]

Bonjour patricktoulon

Il y a un problème connu avec OperatingSystem, j'ai bien:
Application.OperatingSystem = "Windows (32-bit) NT 6.02"
Mais :
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion = 6.3

Et avec la procédure en dessous j'obtiens :
"Microsoft Windows 10 Famille 10.0.14393"

Public Function getOperatingSystem()
Dim localHost  As String
Dim objWMIService  As Variant
Dim colOperatingSystems As Variant
Dim objOperatingSystem As Variant
  On Error GoTo Error_Handler
  localHost = "."
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & localHost & "\root\cimv2")
  Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
  For Each objOperatingSystem In colOperatingSystems
  getOperatingSystem = objOperatingSystem.Caption & " " & objOperatingSystem.Version
  Exit Function
  Next
Error_Handler_Exit:
  On Error Resume Next
  Exit Function
Error_Handler:
  MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
  "Error Number: " & Err.Number & vbCrLf & _
  "Error Source: getOperatingSystem" & vbCrLf & _
  "Error Description: " & Err.Description, _
  vbCritical, "An Error has Occured!"
  Resume Error_Handler_Exit
End Function

 

[Dranreb]

Bonjour.

pourquoi utiliser GetDeviceCaps(GetDC(0), 88) / 72 ou GetDeviceCaps(GetDC(0), 90) / 72

QUAND CECI
(activewindow.activepane.pointstoscreenpixelsx(3)-activewindow.activepane.pointstoscreenpixelsx(0))/3

te donne la même chose

tu qu'a tester

Fait. Chez moi :

Mais je me demande si je ne vais pas figer ça à 4/3 à l'avenir. On sait que c'est la dimension d'un pixel mesurée en 'points', et je n'ai d'ailleurs jamais compris à quoi ça sert que tout ça ne soit pas toujours simplement exprimé en pixels …