Positionner curseur sur une cellule sélectée Windows Excel VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

14/07/2017, 20h30
Nicolas JACQUIN

1 pièce(s) jointe(s)

re

Je ne comprends pas trop ce que vous calculez avec FindWindows (j'ai pas trop compris), mais l problème vient du contour de l'userform, non ????
Peut-être me trompe-je, mais voyez sans correctif et n'importe quelle zoom
Pièce jointe 294144

(.Width - .InsideWidth) / 2)= ce que j'ai à retirer au left

Code:

1
2
3
4
5
6
7
8
9
10
Sub test()
With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
Zooom = ActiveWindow.Zoom / 100
With UserForm1
plus =(.Width - .InsideWidth) / 2) 
.Show 0
.Top = ActiveWindow.PointsToScreenPixelsY(ActiveCell.Top * ppx * Zooom) / ppx
.Left = (ActiveWindow.PointsToScreenPixelsX(ActiveCell.Left * ppx * Zooom) / ppx) - plus
End With
End Sub

Pour moi cela fonctionne bien, n'importe quel zoom

14/07/2017, 23h04
unparia

A Nicolas
Oui, mais ton image donne a penser que là, tu es avec un userform totalement plat (sans effets aero).

non non, l'aéro est bien activé, je me suis servi de la fonction avec les apis pour tirer les contours du userform
(j'arrive plus a mettre la main dessus avec tout les test qui on été fait) , et parti avec un test tout simple
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub Aligne_forme_simple() Dim PtToPx#, Zooom@ Zooom = ActiveWindow.Zoom / 100 PtToPx = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[a1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[a1].Width) / Zooom With UserForm1 .Show 0 .Top = (ActiveWindow.ActivePane.PointsToScreenPixelsY(ActiveCell.Top) / PtToPx) .Left = (ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveCell.Left) / PtToPx) End With End Sub

14/07/2017, 23h26
unparia

Je suggère la lecture attentive de ces deux liens
https://fr.wikipedia.org/wiki/Desktop_Window_Manager

https://msdn.microsoft.com/fr-fr/lib...(v=vs.85).aspx

Pour commencer à comprendre
14/07/2017, 23h38
Nicolas JACQUIN

Je m'incline et vous laisse poursuivre sur votre piste :oops: :oops:
15/07/2017, 08h57
patricktoulon

re

Bonjour
oui jacques c'est dwm.exe qui s'en charge je cherche de ce coté depuis un moment déjà mais je sais pas si on peut le gérer ou utiliser en VBA
en C# oui je le sais
en batch c'est net stop uxsms pour démarrer ou net stop uxsms pour l'arrêter en mode administrateur

et pour le décalage W10 toute version si j'enlève les 3 points SWM_BORDERWIDTH( déterminable dans getsystemmetricS la 32 il me semble)que j'ai avec W7 2007 et que je multiplie par ppx et je les soustrait je tombe pile poil pour w 10

jacques ce qui me conforte dans ton 2d lien c'est qu'il est bien précisé que la déstructuration des paramètres (pas tous) n'ont pas d'effet sur W10 je suis tenté de penser que j'ai raison depuis un moment
window 10 a bien les bordures de W7 mais ells sont occultées ou pris en compte dans les calculs quand même ce que je pense depuis un moment déjà

Citation:

Disabling DWM Composition
Note As of Windows 8, the information in this section is no longer valid.
DWM can no longer be programmatically disabled, nor is it disabled
when an application attempts to draw to the primary display surface.
The following information applies to only Windows 7 and earlier systems.

Français

Citation:

Désactivation de la composition de DWM
Remarque À partir de Windows 8, les informations contenues dans cette section ne sont plus valides.
DWM ne peut plus être désactivé par programmation, et il n'est pas désactivé
quand une application tente de dessiner sur la surface d'affichage principale.
Les informations suivantes s'appliquent uniquement aux systèmes Windows 7 et antérieurs

.
15/07/2017, 09h36
unparia

Citation:

Remarque À partir de Windows 8, les informations contenues dans cette section ne sont plus valides.

n'est pas la traduction exacte, qui est

"Prenez note de ce que les indications données dans cette section ne sont plus valables en ce qui concerne Windows 8"

(juste pour que les choses soient précises).
15/07/2017, 10h03
patricktoulon

re

c'est valable pour W10 aussi

vous aviez testé celle ci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xpoint As Long, ByVal ypoint As Long) As Long
Sub test_userform_replace()
'récuperation du coefficient ppx(pixel to point)
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With ActiveWindow
        'recuperation des point X/Y avec pointstoscreenpixels
        x = (.ActivePane.PointsToScreenPixelsX([d3].Left)) / ppx: Y = (.ActivePane.PointsToScreenPixelsY([d3].Top)) / ppx
        With UserForm1: .Show 0:
            handle1 = FindWindow(vbNullString, UserForm1.Caption)    'hwnd de l'userform(caption)
            .Left = x: .Top = Y:    'positionnement selon pointstoscreenpixels
            handlex = WindowFromPoint(((x) * ppx), ((Y + 10) * ppx))    'récupération du handle vraiment présent sous les points de pointstoscreenpixel
            ' si on est dessus le userform alors on est soit trop court soit pilepoil sinon on est plus loin que les points
            c = IIf(handlex = handle1, 1, -1): a = 0    'donc on ajoutera (1)   si dessus on enlèvera(-1) si on est en dehors incrémenté dans un do loop
            'do loop pour le left: on limite la boucle a 20 itérations en cas de raté pour eviter de boucler infiniment
            Do: a = a + 1: .Left = .Left + c: Loop Until WindowFromPoint((x * ppx), (Y * ppx)) <> handlex Or a = 20
            ' on a donc le x(left exact)maintenant on fait exactement pareil pour le top(Y)
            x = .Left * ppx: handlex = WindowFromPoint((x * ppx), (Y * ppx))    'on reprend donc le handlex avec le x exact du userform et le y de pointstoscreenpixel
            c = IIf(handlex = handle1, 1, -1): a = 0    ' on fait pareil que pour le x si dessus 1 sinon -1 ici on limitera aussi la boucle a 20 itérations
            Do: a = a + 1: .Top = .Top + c: Loop Until WindowFromPoint((x * ppx), (Y * ppx)) <> handlex Or a = 20
        End With
    End With
End Sub

normalement si je ne me trompe pas au pire il devrait avoir "1 point " de défaut du a l'itération du premier tour même si c'est bon d'entrée de jeu
je ne prends pas en considération les version
le principe est juste capter le handle de départ au même cordonnées si c'est le userform c= 1 sinon -1
et dans les deux do loop (left/top) je bouje le userform jusqu'à que les coordonnées me donne un autre handle

15/07/2017, 10h46
Nicolas JACQUIN

1 pièce(s) jointe(s)

Bonjour Patrick,
voila le résult
Pièce jointe 294224
15/07/2017, 11h12
patricktoulon

re

il faut mettre des espions pour a dans chaque do loop pour voir si il est capté au depart
comme toi tu est plus bas et plus loin au depart il est possible que le premier do loop monte a 20
15/07/2017, 11h15
unparia

Je ne sais pas quel regard vous posez sur les choses.
Le mien est on ne peut plus clair --->>
1) Excel n'a rien à voir dans cet aspect-là : savoir positionner précisément une " image " crée par aero en un point spécifié de l'écran. Excel ou pas Excel !
On y parvient si cette " image " est une fenêtre Windows à part entière et je vois mal comment on peut y parvenir si tel n'est pas le cas.
2) dwm.exe ne me semble pas avoir d'autre finalité que de dessiner l' "image" Aero. Je vois mal en quoi il permettrait de déplacer cette " image "
3) je n'ai pas aero et ne peut donc fouiller à la recherche d'une éventuelle API spécifique à cet outil et qui abriterait éventuellement des fonctions permettant un déplacement.
Je me retrouve donc dans la position de celui qui, lisant sur la toile, tente comme il le peut et sans pouvoir tester, de déterminer ce qui pourrait permettre ce déplacement de l' "image " aero elle même.
En l'état actuel des choses, je ne peux que tenter sur la base de suppositions.

Ce ne sera qu'après ces tentatives de prise de connaissances/aero que je maintiendrai mon "test sur le 6" (surtout s'il est dit que l' "image" est une fenêtre Windows à part entière ou qu'au moins un doute persiste à ce sujet) ou qu'au contraire mes recherches conduisent à la découverte que cette "image aero" n'est pas une fenêtre Windows à part entière.

Voilà, Messieurs.

que dit le message

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xpoint As Long, ByVal ypoint As Long) As Long
Sub test_userform_replace()
'récuperation du coefficient ppx(pixel to point)
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With ActiveWindow
        'recuperation des point X/Y avec pointstoscreenpixels
        x = (.ActivePane.PointsToScreenPixelsX([d3].Left)) / ppx: Y = (.ActivePane.PointsToScreenPixelsY([d3].Top)) / ppx
        With UserForm1: .Show 0:
            handle1 = FindWindow(vbNullString, UserForm1.Caption)    'hwnd de l'userform(caption)
            .Left = x: .Top = Y:    'positionnement selon pointstoscreenpixels
            handlex = WindowFromPoint(((x) * ppx), ((Y + 10) * ppx))    'récuperation du handle vraiment present sous les points de pointstoscreenpixel
            ' si on est dessus le userform alors on est soit trop court soit pilepoil sinon on est plus loin que les points
            c = IIf(handlex = handle1, 1, -1): a = 0    'donc on ajoutera (1)   si dessus on enlèvera(-1) si on est en dehors incrementé dans un do loop
            'do loop pour le left: on limite la boucle a 20 iteration en cas de raté pour eviter de boucler infiniment
            Do: a = a + 1: .Left = .Left + c: Loop Until WindowFromPoint((x * ppx), (Y * ppx)) <> handlex Or a = 20
            texte = "pour le left C= " & c & " et a = " & a & vbCrLf
            ' on a donc le x(left exact)maintenant on fait exactement pareil pour le top(Y)
            x = .Left * ppx: handlex = WindowFromPoint((x * ppx), (Y * ppx))    'on reprend donc le handlex avec le x exact du userform et le y de pointstoscreenpixel
            c = IIf(handlex = handle1, 1, -1): a = 0    ' on fait pareil que pour le x si dessus 1 sinon -1 ici on limitera aussi la boucle a 20 itérations
            Do: a = a + 1: .Top = .Top + c: Loop Until WindowFromPoint((x * ppx), (Y * ppx)) <> handlex Or a = 20
            texte = texte & "pour le top  C= " & c & " et a = " & a
 
        End With
    End With
    MsgBox texte
End Sub

15/07/2017, 11h20
patricktoulon

re

Citation:

1) Excel n'a rien à voir dans cet aspect-là : savoir positionner précisément une " image " crée par aero en un point spécifié de l'écran. Excel ou pas Excel !

on a tres bien compris ton point de vue
mais au vue de tout les tests on voit bien que aero n'est pas gérable alors on déplace le userform
si tu préfère on pourrait changer le titre
posé le userform la ou se trouve la cellule a l'écran
15/07/2017, 11h30
Nicolas JACQUIN

1 pièce(s) jointe(s)

Pièce jointe 294234
15/07/2017, 11h44
patricktoulon

re

ca semble confirmer ce que j'ai dis plus haut
l'écart que tu a a gauche est pile poil celui des bordures W7 tu a donc bien des bordures mais elles sont occultées(transparence)
je vois que ca

mon switch est finalement bien plus simple hein !!?
juste par curiosité
que dis le message ici

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test_userform_replace333()
'récuperation du coefficient ppx(pixel to point)par le dpi
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With ActiveWindow
        'recuperation des point X/Y avec pointstoscreenpixels
        Z = .Zoom / 100
       ppxL = ((.ActivePane.PointsToScreenPixelsX([d3].Width) + 1) - (.ActivePane.PointsToScreenPixelsX(0) + 1)) / (([d3].Width) + 1) / (Z + 0.01)
        x = (.ActivePane.PointsToScreenPixelsX([d3].Left) / ppxL)
        x2 = (.ActivePane.PointsToScreenPixelsX([d3].Left) / ppx)
 
        MsgBox "difference en pixel " & x - x2 & vbCrLf & " diiference en points " & (x - x2) / ppx
         With UserForm1:
         '.Show 0:
            '.Left = (x + 1) / ppxL: .Top = (Y + 1) / ppxL: 'positionnement selon pointstoscreenpixels
        End With
    End With
End Sub

15/07/2017, 12h20
unparia

Il n'est pas certain, Patrick qu'une telle démarche aboutisse. Plusieurs raisons à cela, parmi lesquelles :
- chou blanc si pas fenêtre Windows à part entière
- si (dit plus haut) fenêtre Windows à part entière : gaffe à ce que retourne Findwindows qui s'appuie sur un caption qui peut être identique pour les deux fenêtres et sera retenue la 1ère trouvée et non forcément celle du userform lui-même.
Moi, je n'ai pas aero, mais toi oui : des essais avec enumwindows te conduiront PEUT-ETRE à y voir plus clair ! Je les ferais, si j'étais toi et sur ta machine.

Par ailleurs : la librarie utilisée par aero semble être la librairie dwmapi.dll. Il n'est pas interdit de penser qu'il serait utile de s'intéresser à la DwmExtendFrameIntoClientArea qu'elle contient entre autres fonctions. ;) Je ne peux le faire (sans aero).
15/07/2017, 12h22
Nicolas JACQUIN

1 pièce(s) jointe(s)

Pièce jointe 294243

Voir 40 message(s) de cette discussion en une page