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

Version imprimable

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

28/05/2017, 20h02
Nicolas JACQUIN

Après cela dépend peut-être du paramétrage du ruban, non ?
Ruban = 71
cadre = 11
Caption = 29.5
28/05/2017, 20h33
mjpmjp

bonjour,

Citation:

A sa suite, je voudrais simplement positionner la flèche de la souris au milieu de cette cellule sélectée.
Cela quelque soit la taille de la feuille affichée et son positionnement sur l'écran..
(Par ex. Pour ensuite avoir la possibilité d' une modification de valeurs dans cette cellule par le clavier ou un déclenchement par BeforeRightClick).

la cible c'est bien la cellule ? --> oui
on connait les coordonnées de la cellule ? --> oui
on connait la largeur et la hauteur ? --> oui
on sait trouvé le milieu ? --> oui

Tout est RELATIF...;)

@+JP
28/05/2017, 20h49
Nicolas JACQUIN

Patrick
Le ruban passe de 71 à 100 %, à 82.92 à 110 %

Moi, je voudrais bien savoir ce qui résulte de ce code sur ta machine, Nicolas JACQUIN, avec ton userform et son ombrage :
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub CommandButton1_Click() With UserForm1 .BorderStyle = fmBorderStyleNone .StartUpPosition = 0 .SpecialEffect = fmSpecialEffectFlat .Top = Application.Top .Left = Application.Left .Show End With End Sub
Ce code positionne le userform dans l'angle supérieur gauche de la fenêtre application.
Un userform sans effet d'ombrage s'y trouve "collé"
Que se passe-t-il avec le tien ? Sont-ce les vraies bordures du userform qui s'y trouvent collées où sont-ce les bordures de l' "ombrage" ?

28/05/2017, 21h38
Nicolas JACQUIN

1 pièce(s) jointe(s)

Il y a quand même l'ombrage
Pièce jointe 280196
28/05/2017, 21h45
unparia

Citation:

Il y a quand même l'ombrage

Merci
Oui, mais on peut dès lors écarter sa responsabilité. C'est ce que je voulais savoir. Merci.
28/05/2017, 22h25
patricktoulon

re

oui visuellement il peut prêter a confusion je fait les test sans aero pour mieux voir
28/05/2017, 22h28
patricktoulon

2 pièce(s) jointe(s)

re

Citation:

Patrick
Le ruban passe de 71 à 100 %, à 82.92 à 110 %

c'est pas logique ca ne correspond pas a ce que l'on voit
regarde la capture le ruban n'est pas modifier avec le zoom
Pièce jointe 280213
28/05/2017, 22h30
Nicolas JACQUIN

Citation:

Envoyé par patricktoulon

c'est pas logique ca ne correspond pas a ce que l'on voit

5 min je refais
28/05/2017, 22h37
Nicolas JACQUIN

1 pièce(s) jointe(s)

Oui escuse c'est moi, parce que j'avais changé cette ligne

Code:

pppx = ((.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3) / Z

Pièce jointe 280215
28/05/2017, 22h50
patricktoulon

re

et oui en fait que ce soit 100 ou 200% le ruban ne devrait pas changer mais pourtant oui, les chiffres parlent

en fin de compte seule est universelle app.left et activewindow.left tout le reste sans parler de dimensions différentes ont un comportement différent
parti de la ca peut durer encore longtemps
28/05/2017, 22h52
Nicolas JACQUIN

Citation:

Envoyé par patricktoulon

et oui en fait que ce soit 100 ou 200% le ruban ne devrait pas changer mais pourtant oui, les chiffres parlent

en fin de compte seule est universelle app.left et activewindow.left tout le reste sans parler de dimensions différentes ont un comportement différent
parti de la ca peut durer encore longtemps

Ben oui c'est ce que je disais un peu plus haut, je pense que c'est du cas par cas

exemple cici
le userform devrait toujour avoir le meme top a 100 ou 200

Code:

1
2
3
4
5
6
7
8
Sub test()
    With UserForm1
        .Show 0
        pppx = (ActiveWindow.ActivePane.PointsToScreenPixelsX(3) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 3
        .Top = Application.Top + CommandBars("Ribbon").Height / pppx
        .Left = 150
    End With
End Sub

c'est pour te dire a quel point on cours après un chimère

28/05/2017, 23h02
Nicolas JACQUIN

1 pièce(s) jointe(s)

Pièce jointe 280230

top à 113.25

avec cet exemple le userform est il bien a 0 de la grille en left

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Set app = Application: Set actw = ActiveWindow
    Z = (actw.Zoom / 100)
    With actw.ActivePane
        pppx = (.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3
        cadre = (app.Width - app.UsableWidth) / 3
    End With
    With UserForm1
        .Show 0
        pppx = (ActiveWindow.ActivePane.PointsToScreenPixelsX(3) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 3
        .Top = 300
        .Left = app.Left + actw.Left + cadre * 2 + 24 * Z
    End With
End Sub

28/05/2017, 23h21
Nicolas JACQUIN

1 pièce(s) jointe(s)

Pièce jointe 280240

La c'est en 100%

et oui donc toi il faut enelever cadre au left et a jouter cadre au top

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Set app = Application: Set actw = ActiveWindow
    Z = (actw.Zoom / 100)
    With actw.ActivePane
        pppx = (.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3
        cadre = (app.Width - app.UsableWidth) / 3
    End With
    With UserForm1
        .Show 0
        pppx = (ActiveWindow.ActivePane.PointsToScreenPixelsX(3) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / 3
        .Top = Application.Top + CommandBars("Ribbon").Height / pppx + cadre
        .Left = app.Left + actw.Left + 25 * Z
    End With
End Sub

la normalement tu est juste au dessus de la barre des formules et a gaughe 0 de la grille

28/05/2017, 23h28
Nicolas JACQUIN

1 pièce(s) jointe(s)

Pièce jointe 280245

oups j'ai inverssé sur les label
28/05/2017, 23h41
patricktoulon

re

maintenant zoom et tu va voir
28/05/2017, 23h44
Nicolas JACQUIN

1 pièce(s) jointe(s)

zoom à 150 %, mais remonte déjà avant

Pièce jointe 280255
28/05/2017, 23h58
patricktoulon

re

et voila tout ca pour te montrer que tu n'y arrivera pas tout simplement parce que notre principe du "*zoom" n'est pas bon
on peut que bricoler pour ajuster au plus proche mest l'exact faut pas y compter
j'ai créé 17 methode différente qui fonctionnent chez moi y en a pas une qui suit le zoom correctement de 100 a 200%
29/05/2017, 00h02
Nicolas JACQUIN

oui, mais moi je suis content j'ai réussi pour moi (mais deux versions avec et sans api) c'est déjà ça et j'ai encore embêté mon monde :)
aller je vais au dodo et on se revoie pour un prochain sujet hard :mrgreen:
Bonne nuit.
29/05/2017, 00h16
patricktoulon

re

non c'est le genre de tracas que j'aime bien résoudre

tu n'ennuie personne pas moi en tout cas
bonne nuit
29/05/2017, 20h22
Nicolas JACQUIN

4 pièce(s) jointe(s)

Bonjour Patrick et Unparia,

Je vous embête pas longtemps, juste pour vous dire que la correction de -6 que j'avais faites dans la fonction sans api est bien de -5 comme la fonction avec api
j'ai remarquer en agrandissant encore + le zoom
capture sans api

Pièce jointe 280527
Pièce jointe 280529
Pièce jointe 280534
Pièce jointe 280539

Précis hein ?? ;)
Allez bonne soirée

Bonjour à tous
1) avant et surtout de continuer : je voudrais exprimer regrets (pour mon emportement) et excuses (pour mon emportement également) à chacun.
2) Il se peut que le code suivant, qui ne fait nulle part appel à une "estimation" quelconque en fonction de version, etc ... fonctionne sur toutes les machines :
Code:

1 2 3 4 5 6 7 8 9 Set cible = Range("D4") Z = ActiveWindow.Zoom / 100 With ActiveWindow pttopy = ((.ActivePane.PointsToScreenPixelsY(cible.Offset(1, 0).Top) - .ActivePane.PointsToScreenPixelsY(cible.Top)) / cible.Height) / Z pttopx = (.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left) - .ActivePane.PointsToScreenPixelsX(cible.Left)) / cible.Width / Z UserForm1.Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(cible.Top) / pttopy UserForm1.Left = ActiveWindow.ActivePane.PointsToScreenPixelsX(cible.Left) / pttopx UserForm1.Show End With
Pouvez-vous me dire ce qu'il en est ?
3) s'il fonctionne sur toutes les machines :
- a) une partie de ce code est à porter au crédit de zenpbb, que j'applaudis à nouveau
- b) une autre partie, bien que transformée, est à porter au crédit de patricktoulon
- c) j'éprouve quelque gêne de ne pouvoir expliquer totalement et avec rigueur pourquoi exactement les choses marchent ainsi (je n'aime pas être dans une telle situation).
J'ai bien quelques idées d'explications, mais elles ne sont pas encore suffisamment étayées dans mon propre esprit.
Amitiés à tous.

29/05/2017, 21h03
Nicolas JACQUIN

1 pièce(s) jointe(s)

Bonsoir Unparia

Pièce jointe 280542

Encore juste un dernier truc pour Patrick,
avec ta fonction en B3 et B3:F12, ça marche aussi maintenant et avec n'importe quel Zoom

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
28
Function PositionForm(usf, rng)
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) - 5
ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * Z) + 10, usf.Width)
Hheight = IIf(rng.Rows.Count > 1, (rng.Height * Z) + 5, usf.Height)
 
PositionForm = Array(lleft, ttop, Wwidth, Hheight)
 
End Function
 
Sub TestUserform()
    r = PositionForm(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub
 
Sub TestUserformDansPlage()
    r = PositionForm(UserForm1, [B3:F12])
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): .Width = r(2): .Height = r(3): End With
End Sub
 
Sub TestUserformtopleftcell()
    r = PositionForm(UserForm1, [B3])
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub

29/05/2017, 22h31
patricktoulon

re

re bonsoir Nicolas
oui j'avais une version similaire sauf que moi c'est pas -5 mais +1 en effet la différence est toujours ce "+6 ou -6" chez moi/chez toi

elle ressemble beaucoup a celle que j'ai donné a tester dont j'ai eu que des retour positif

sauf que moi je met +cadre direct a la place du "-5" et je rajoute - cadre si l'application.operatingsystem like"/" comme ca elle est universelle

tu t'amuse avec ca hein :mrgreen:
29/05/2017, 22h34
Nicolas JACQUIN

oui ça me plait et ça m'entraine à cogiter
29/05/2017, 22h47
patricktoulon

re

pour ton -5 ou plus +10
fait une petite verif chez toi

Code:

cadre=application.height-application.usablehaight

ou pareil avec un userform

cadre2=.height-.insideheight

et dire que tout le monde a dénigré pointstoscreenpixels hein !!!????
29/05/2017, 22h58
Nicolas JACQUIN

Bein je sais pas, il me donne 181.5, ça colle pas du tout
29/05/2017, 23h09
Nicolas JACQUIN

non ça fonctionne pas, ça inversse le sens avec un decalage de +5

pardon je me suis trompé c'est width pour les cadre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function PositionForm(usf, rng)
Dim Zooom#, ptToPx#, cadre#, cadre2#
cadre1 = Application.Width - Application.UsableWidth
cadre2 = usf.Width - usf.InsideWidth
heughtcadre = usf.Height - usf.InsideHeight
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) + cadre2 'ou cadre1/3*2 pour nicolas c'est le signe (+/-)qui change
ttop = .PointsToScreenPixelsY((rng.Top * ptToPx) * Zooom) / ptToPx
End With
 
Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * Zooom) - cadre1, usf.Width)
Hheight = IIf(rng.Rows.Count > 1, (rng.Height * Zooom) - heughtcadre, usf.Height)
 
PositionForm = Array(lleft, ttop, Wwidth, Hheight)
 
End Function

29/05/2017, 23h27
Nicolas JACQUIN

2 pièce(s) jointe(s)

Pièce jointe 280572voila ce que ça donne tel quel, sinon j'ai pas compris 1/3*2 en vert

Pièce jointe 280569

Bonsoir,

@unparia

sur ma machine, ton code (assez limpide au final) fonctionne bien, en le modifiant légèrement :

Code:

1
2
3
4
5
6
7
8
9
    Set cible = ActiveCell
    Z = ActiveWindow.Zoom / 100
    With ActiveWindow
        pttopy = ((.ActivePane.PointsToScreenPixelsY(cible.Offset(1, 0).Top) - .ActivePane.PointsToScreenPixelsY(cible.Top)) / cible.Height) / Z
        pttopx = ((.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left) - .ActivePane.PointsToScreenPixelsX(cible.Left)) / cible.Width) / Z
        UserForm1.Show 0
        UserForm1.Top = .ActivePane.PointsToScreenPixelsY(cible.Top) / pttopy
        UserForm1.Left = .ActivePane.PointsToScreenPixelsX(cible.Left) / pttopx
    End With

...
sauf si on réduit les dimensions de la cellule cible tout en jouant sur la valeur du zoom, auquel cas, ça déconne un peu (sans doute de problèmes de précision pts vs pixels ?), et du coup, j'obtiens de meilleurs résultats ainsi (même si c'est très empirique d'introduire un coef) :

Code:

1
2
3
4
5
6
7
8
9
10
11
  Set cible = ActiveCell
  Set cible = ActiveCell
    Z = ActiveWindow.Zoom / 100
    coef = 10
    With ActiveWindow
        pttopy = ((.ActivePane.PointsToScreenPixelsY(cible.Offset(1, 0).Top * coef) - .ActivePane.PointsToScreenPixelsY(cible.Top * coef)) / cible.Height / coef) / Z
        pttopx = ((.ActivePane.PointsToScreenPixelsX(cible.Offset(0, 1).Left * coef) - .ActivePane.PointsToScreenPixelsX(cible.Left * coef)) / cible.Width / coef) / Z
        UserForm1.Show 0
        UserForm1.Top = .ActivePane.PointsToScreenPixelsY(cible.Top) / pttopy
        UserForm1.Left = .ActivePane.PointsToScreenPixelsX(cible.Left) / pttopx
    End With

que te donne les
width-usable width de l'application

et le
height-insideheight de l'userform
sinon tu peut faire simplement ca sur la tienne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Function PositionForm2(usf, rng)
    Dim Z As Double, K As Double
    cadre = IIf(Application.OperatingSystem Like "*/*", -5, 1)
    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) + cadre
    ttop = ActiveWindow.PointsToScreenPixelsY(rng.Top * K * Z) / K
    'ici c'est pas bon trop large ,trop grand
    Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * Z) + 10, usf.Width)
    Hheight = IIf(rng.Rows.Count > 1, (rng.Height * Z) + 5, usf.Height)
    PositionForm = Array(lleft, ttop, Wwidth, Hheight)
End Function

29/05/2017, 23h49
Nicolas JACQUIN

1 pièce(s) jointe(s)

j'ai pas compris ce que tu m'as demandé de faire mais ton code donne ça, c'est mieux

Pièce jointe 280577
29/05/2017, 23h55
Nicolas JACQUIN

1176.75 pour le 1er
0 pour le 2eme
désolé j'avais pas capté
29/05/2017, 23h56
patricktoulon

re

que donne chez toi

Code:

msgbox Application.OperatingSystem
29/05/2017, 23h58
Nicolas JACQUIN

Windows(32-bits) NT 10.00

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