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

Version imprimable

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

24/05/2017, 15h34
Nicolas JACQUIN

1 pièce(s) jointe(s)

Bonjour à tous,
j'ai fait un essai avec ton code Patrick, je n'ai rien modifié à ton exemple mais chez moi ça ne fonctionne pas ?
Pièce jointe 278817
une idée du problème
24/05/2017, 17h49
patricktoulon

re

quel était la cellule ciblée?
24/05/2017, 17h56
Nicolas JACQUIN
a la base je suis parti avec exactement le même code que toi pour essayer, parce que je suivais votre discution depuis un moment et trouvais ça interessant
Code:

1 2 3 4 Sub TestUserformtopleftcell() r = RectanGleRange(UserForm1, [b3]) With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With End Sub

mon dernier en date c'est celui la

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub TestUserformtopleftcell()
    r = RectanGleRange(UserForm1, [b3])
    With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
End Sub
 
Function RectanGleRange(usf, rng)
    Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth#, zz#
    With ActiveWindow
        pttopx = (.ActivePane.PointsToScreenPixelsX(3) - .ActivePane.PointsToScreenPixelsX(0)) / 3    'coefficient multiplicateur pixel
        zz = (.Zoom / 100)
        ecc = (usf.Width - usf.InsideWidth) * (4 / 3)    'epaisseur du cadre
        ecc2 = ((usf.Height - usf.InsideHeight) / 2)   'epaisseur du cadre
        lleft = ((.ActivePane.PointsToScreenPixelsX(rng.Left) / pttopx) * zz) + (ecc)
        ttop = ((.ActivePane.PointsToScreenPixelsY(rng.Top) / pttopx) * zz) + (ecc)
        Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * zz) - (ecc) - pttopx - 2, usf.Width)
        Hheight = IIf(rng.Rows.Count > 1, (rng.Height * zz) - (ecc) - pttopx - 2, usf.Height)
    End With
    RectanGleRange = Array(lleft, ttop, Wwidth, Hheight)
End Function

si c'est pas bon adapte le a toi et donne moi la résolution de ton écran,le mode d'affichage Windows, le zoom appliqué au sheets et les adaptations que tu aura faite
pour voir

24/05/2017, 18h02
Nicolas JACQUIN

ok je regarde tout ça, je te tiens au courant, merci
24/05/2017, 18h23
unparia

Citation:

adapte le a toi

Tu peux nous dire ce que cela veut dire, s'il te plait, patricktoulon ?
24/05/2017, 19h26
Nicolas JACQUIN

2 pièce(s) jointe(s)

re,
ben oui j'avoue et je suis un peu comme Jacques que je salut au passage, sur un classeur vierge avec tes codes à l'identique je suis complètement à coté.
C'était pour essayer juste voir si c'était un code universel comme il me semblait l'avoir compris
Mes paramêtres d'affichage Windows ou excel sont à 100%

Pièce jointe 278933
Pièce jointe 278937
24/05/2017, 21h02
patricktoulon

re

ben ca veut dire ajoute ou enlevé ce qui faut et donne moi les données pour que je puisse avoir une idée de pourquoi
24/05/2017, 21h13
Nicolas JACQUIN

je ne sais pas quoi te dire de plus,
ta superbe démo en poste 96 chez moi ça ne marche pas
24/05/2017, 21h14
unparia

Citation:

ben ca veut dire ajoute ou enlevé ce qui faut

Tu voudras bien m'excuser, patricktoulon, mais je trouve cette manière de "travailler" et "raisonner" à "tâtons" à la fois étrange, hasardeuse et vraiment peu conforme à la raison. ;).

EDIT : je te l'ai déjà fait observer (mon message n° 69 d'il y a déjà une semaine).
24/05/2017, 21h22
patricktoulon

re

ben ma fois mes calcul n'on aucun dividendes en dur et utilises les fonctions il y a donc un paramètre que l'on ignore il faut bien commence par quelque chose
selon ce qui manque ou en trop ca pourra me donner une idées du pourquoi
24/05/2017, 21h27
unparia

Citation:

il y a donc un paramètre que l'on ignore

pas "que l'on", patricktoulon ... "que TU". Et pour être plus précis : dont tu t'obstines à ne pas vouloir tenir compte en dépit des efforts faits (dessins, explications, etc ...)
Tu y seras encore dans quelques mois, si tu n'en tiens pas compte.
24/05/2017, 21h30
Nicolas JACQUIN

Donc ton code n'est pas universsel en faites, parce que c'est casiment impossible à faire je pense,
parce que chaque écran et carte graphique surtout n'enverront jamais le même nombre de point par pixel pour tomber sur une cellule précise avec un userform.
j'avoue que je ne comprend pas trop
tampis et bonne soirée à tous
24/05/2017, 22h57
patricktoulon

re

oui mais le calcul c'est le même pour tous

1 point X((4/3)*(coeficient DPI))=X pixels

p=4/3 >>>>> =1.333333333333333

coeff DPI= 1.25 chez moi soit 125%

P X (coeficient DPI) =1,666666666666667

soit exemple 100 points=100 X1.666666666666667=166,66666667 pixel

nicolas teste ca et dis moi le msgbox
y a pas d'ambiguïté

Code:

1
2
3
4
5
6
7
8
9
10
11
12
SSub test7()
    With ActiveWindow
        widthpixel = .ActivePane.PointsToScreenPixelsX(ActiveSheet.[b1].Width) - .PointsToScreenPixelsX(0)
        coeff = widthpixel / [b1].Width
        texte = "en pixel b1.width = " & widthpixel & " pixels" & vbCrLf
        texte = texte & "coeff = le width en pixel diviser par le width en point = " & coeff & vbCrLf
        texte = texte & " le width pixel divisé par le coeff done le width en point =" & widthpixel / coeff & vbCrLf
        texte = texte & "le width directement demader par b1.width = " & [b1].Width
    End With
    MsgBox texte
End Sub
End Sub

2 pièce(s) jointe(s)

Pièce jointe 278993
oui ça correspond avec tes données, je sait pas pourquoi ça ne marche pas
parcontre je suis tomber la dessus et sa tombe bien en rajoutant -5

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 Private Declare Function GetDC& Lib _
 "user32.dll" (ByVal hwnd&)
 Private Declare Function GetDeviceCaps& _
 Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
 Sub UserFormAlign1() '''''''''''''''OK'''''''''''''''''
 Dim x As Double, y As Double, w As Double, h As Double
 x = GetDeviceCaps(GetDC(0), 88) / 72
 y = GetDeviceCaps(GetDC(0), 90) / 72
 With UserForm1
 .StartUpPosition = 0
 .Left = (ActiveWindow.PointsToScreenPixelsX(ActiveCell.Left * x) * 1 / x) - 5
 .Top = ActiveWindow.PointsToScreenPixelsY(ActiveCell.Top * y) * 1 / y
 .Show
 End With
 End Sub

Pièce jointe 279008

25/05/2017, 00h23
patricktoulon

re

oui avec les api je connais
ben tien si tu veux rire fait un msgbox x ou y tu va voir mort de rire
25/05/2017, 00h26
Nicolas JACQUIN

1.333333333

1 pièce(s) jointe(s)

en modifiant ton code regarde, je sais pas plus mais c'est mieux

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function RectanGleRange(usf, rng)
    Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth#, zz#
    With ActiveWindow
        pttopx = (.ActivePane.PointsToScreenPixelsX(3) - .ActivePane.PointsToScreenPixelsX(0)) / 3.014   'coefficient multiplicateur pixel
        zz = (.Zoom / 100)
        ecc = (usf.Width - usf.InsideWidth) * (4 / 3)    'epaisseur du cadre
        ecc2 = ((usf.Height - usf.InsideHeight) / 2)   'epaisseur du cadre
        lleft = (.ActivePane.PointsToScreenPixelsX(rng.Left) / pttopx) '* zz) + (ecc)
        ttop = (.ActivePane.PointsToScreenPixelsY(rng.Top) / pttopx) '* zz) + (ecc)
        Wwidth = IIf(rng.Columns.Count > 1, rng.Width, usf.Width)
        Hheight = IIf(rng.Rows.Count > 1, rng.Height, usf.Height)
    End With
    RectanGleRange = Array(lleft, ttop, Wwidth, Hheight)
End Function

Pièce jointe 279012
c'est du pif j'avoue mais si ça te donne une idée de ce qui va pas

25/05/2017, 00h33
patricktoulon

1 pièce(s) jointe(s)

re

regarde ce que ca donne chez moi
Pièce jointe 279017

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