oui ca j'avais plus ou moins compris mais même avec un coefficient ca ne marche pas
j'ai tester différentes solution avec différentes propriétés
activewindow
activepane
application
etc...
aucune combinaison de 2 et plus ne matchent
Version imprimable
oui ca j'avais plus ou moins compris mais même avec un coefficient ca ne marche pas
j'ai tester différentes solution avec différentes propriétés
activewindow
activepane
application
etc...
aucune combinaison de 2 et plus ne matchent
je te montre cela demain après-midi (je vais au dodo, maintenant).
Je commençais à m'y mettre de bon matin lorsque, entamant mes calculs, je me suis d'un seul coup rappelé que je t'en avais dit l'essentiel il y a déjà .... 12 jours !
Et que tu avais appelé cela : ma "petite fonction" !!!
Ah bon, "petite foonction" ? Hé bien -->> je vais boire mon "petit café" et reviens en l'appliquant, cette "petite fonction" :coucou:
EDIT : et je viens de voir que j'étais même allé, un peu plus loin (il y a 9 jours), à préciser :
Hééééé... ouais ....Citation:
Et crois-tu que je ne t'ai pas dit (presque totalement) sans utiliser l'api de windows ?
C'est ce que tu as appelé ma "petite fonction", qui te le permet.
Je t'ai même dit plus haut (relis-moi) qu'il fallait ensuite convertir pour le curseur, mais qu'il n'était pas nécessaire de convertir pour simplement placer un userform .
Et ces coordonnées ne dépendent, elles, en aucun cas du zoom. Elles restent fixes. Seul le "miroir" résultant du zoom voit ses dimensions, etc ... transformées à l'intérieur de cette fenêtre (qui, elle, est fixe)
Elles dépendent par contre de ce que l'on affiche ou non les titres (de lignes et de colonnes), ainsi que des coordonnées de l'Application et de celles de la grille au sein de la fenêtre active
je suis remonter a ta capture détaillant les parties
bref sans api non quoi?
Sans AUCUNE fonction de l'Api de Windows ...Citation:
bref sans api non quoi?
sans parler du mode modeless qui change tout
teste ca avec 0 ou pas après show
Code:
1
2 UserForm1.Show UserForm1.Left = CDbl([D3].Left + AA.PointsToScreenPixelsX(0)) 'AA.PointsToScreenPixelsX([D3].Left) - AA.PointsToScreenPixelsX(0) / pttpx
Bon ...
Je vais te mettre sur la voie de l'essentiel et te laisser faire des calculs à partir de ce code qui, à cette étape, ne traite pas le zoom (donc à 100%) :
1) J'ai à cette étape traité tout le reste (ruban, barre des formules, fenêtres flottantes, barre des titres)Code:
1
2
3
4
5
6
7
8
9
10 Private Sub CommandButton1_Click() bh = IIf(ActiveWindow.DisplayHeadings, UserForm1.Height - UserForm1.InsideHeight - 6, 2) bl = IIf(ActiveWindow.DisplayHeadings, bh - 1, 0) Set cible = Range("E10") h = Application.Top + (Application.Height - Application.UsableHeight) + ActiveWindow.Top l = Application.Left + (Application.Width - Application.UsableWidth) + ActiveWindow.Left UserForm1.Show UserForm1.Top = (h + (cible.Top) + bh - Cells(ActiveWindow.ScrollRow, 1).Top) UserForm1.Left = l + (cible.Left) + bl - Cells(1, ActiveWindow.ScrollColumn).Left End Sub
regarde bien la première ligne :
a) le 6 et le 2 ne sont pas arbitraires (ils sont toujours vrais et correspondent à quelque-chose de très précis. Tu devrais trouver à quoi, si tu observes bien)
b) j'aurais pu éviter d'utiliser la fenêtre du userform (on peut parvenir autrement au calcul de bh et de bl, mais au prix d'un très bref clignotement de l'écran)
2) reste à faire quelques calculs arithmétiques que je souhaite te voir faire (ou tenter de le faire) seul dans un premier temps.
Pourquoi est-ce que j'ai choisi de te laisser d'abord seul traiter cet aspect ? --->> tout simplement parce-que c'est là très nettement le meilleur moyen de te faire bien appréhender ce que sont :
- les différentes fenêtres de l'application Excel
- le zoom et à quoi il s'applique
Pour t'y aider, je t'invite à bien regarder et re-regarder l'une des captures d'écran que j'ai affichées dans cette discussion d'abord, puis la dernière capture (qui met en exergue le principe "miroir et homothétie" utilisé par Excel.
Prends ton temps. Ne te précipite pas.
Tu devrais y arriver sans mon aide si tu sais :
- observer
- prendre ton temps (surtout)
- calculer
Bons calculs (il pleut et ce sera là un bon divertissement).
Ah oui. J'ai oublié de rajouter ce qu'il faut pour le cas où application en plein écran --->>
Ajouter cette ligne de code :
Juste APRES (APRES, hein ... pas avant) celle qui ditCode:If Application.DisplayFullScreen Then bh = bh + bh - 2
Code:bl = IIf(ActiveWindow.DisplayHeadings, bh - 1, 0)
bon ben voila ma version
il y a une toute petite divergence avec ta version
j'utilse le width/insidewidth pour le top
et height/insideheight pour le left
pour le left on pourrait l'admettre la colonne des chiffre peut mesurer le coefficiant mais pour le top j'ai du mal
en tout cas ca marche
tu veux bien essayer
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 Sub test3() 'devrait correspondre a ton -6 ecc = (UserForm1.Width - UserForm1.InsideWidth) 'devrait correspondre a la hauteur d'une caption soit une display barre(heading/formulas/etc....y compris la largeur de la colonne des N°colonne a gauche ) ecc2 = (UserForm1.Height - UserForm1.InsideHeight) ttop = (Application.Top + 1 + Application.Height - Application.UsableHeight) - (ecc) + [d3].Top - Cells(ActiveWindow.ScrollRow, 1).Top lleft = (Application.Left + 1 + Application.Width - Application.UsableWidth) + (ecc2) + [d3].Left - -Cells(ActiveWindow.ScrollColumn, 1).Left ttop = ttop * (ActiveWindow.Zoom / 100) lleft = lleft * (ActiveWindow.Zoom / 100) UserForm1.Show UserForm1.Top = ttop UserForm1.Left = lleft End Sub
Ben non ! (et j'ai quand-même essayé, bien que sachant que non).Citation:
en tout cas ca marche
tu veux bien essayer
Je te l'ai dit et le répète : PRENDS TON TEMPS
Et en passant (mais ce n'est pas la seule erreur) : comment fais-tu pour connaître le nouveau coût de revient d'une tasse de café lorsque le prix du seul sucre a augmenté de 10 % sans connaître (et séparer dans tes calculs) :
- le coût originel (avant augmentation) de la dose de sucre mise dans une tasse
- le coût de tous les autres ingrédients mis dans la tasse)
- le coût de tous les autres frais (électricité, taxes, salaires, etc ...)
OK ? --->> PRENDS DONC TON TEMPS sur ces bases. CESSE DE TE PRECIPITER (sinon : je te laisse là). ;)
alors j'y comprends plus rien
ton calcul tel que tu me l'a donné me donne au moins 11 points de marge d'erreur soit e10 comme cible et se retrouve en d9 a l'intérieur
et j'ai le zoom a 100%
on est tellement loin du (même résultat) l'un de l'autre
Pièce jointe 277474
ou alors il y a un parametre écran ou autre que l'on ignore qui est diffèrent de toit a moi ce qui fait que le calcul est different
en effet dans mon exemple je n'ai pas pris en compte le active window flottant (le classeur ne remplit pas toute l'application)
voila je le prends en compte le flottant
Code:
1
2
3
4
5
6
7
8
9
10
11 Sub test8() Dim ecc#, ecc2#, ttop#, lleft#, zz#, ApP As Object, ActW As Object, usf As Object Set ApP = Application: Set ActW = ActiveWindow: Set usf = UserForm1 With usf: ecc = (.Width - .InsideWidth): ecc2 = (.Height - .InsideHeight): End With zz = (ActW.Zoom / 100) With ApP ttop = (((.Top + 1 + .Height - .UsableHeight) + (actW.Top + ecc2)) - (ecc) + [E10].Top - Cells(ActW.ScrollRow, 1).Top) * zz lleft = (((.Left + 1 + .Width - .UsableWidth) + (actW.Left + ecc)) + (ecc2) + [E10].Left - -Cells(ActW.ScrollColumn, 1).Left) * zz End With With UserForm1: .Show: .Top = ttop: .Left = lleft: End With End Sub
Excuse-moi, mais ... je t'abandonne.
Bonne chance.
merci
maintenant que j'ai compris ton calcul je te le donne avec "PointsToScreenPixelsX"
car en effet cette fonction fait les ajout des partie toute seule sauf les épaisseurs de cadre (width-insidewidth)
on a plus a se préoccuper du top application,activewindow.top ,etc......
si tu repasse par laCode:
1
2
3
4
5
6
7
8
9
10 Sub test2() Dim pttopx#, ttop#, lleft# With ActiveWindow.ActivePane pttopx = (.PointsToScreenPixelsX(33) - .PointsToScreenPixelsX(0)) / 33 ecc = (UserForm1.Width - UserForm1.InsideWidth) lleft = (.PointsToScreenPixelsX([d3].Left) + (ecc * pttopx)) / pttopx ttop = (.PointsToScreenPixelsY([d3].Top) + (ecc * pttopx)) / pttopx End With With UserForm1: .Show 0: .Left = lleft: .Top = ttop: End With End Sub
oui ... je lis ... je lis ... (et toi tu ne lis pas, à commencer par l'exemple du sucre dans la tasse de café).Citation:
si tu repasse par la
Te rends-tu compte au moins de ce que tu fais-là ?
Je vais te le dire :
tu utilises des calculs pour extraire en nouvelle échelle d'unités des coordonnées que tu ramènes ensuite dans l'échelle originelle.
Ah ouais -->> tu auras en effet ainsi les coordonnées à l'écran (par rapport à l'ensemble de la fenêtre Application) , dans la bonne échelle d'unités, du coin supérieur gauche de la cellule traitée, sans facteur de zoom.
Et ? tu comptes appliquer quel coefficient/zoom à ces coordonnées-là ?
Réponds à cette simple question toute bête (sans le moindre code supplémentaire "jeté" ici en "test") ?
Mais ne réponds pas avant d'avoir lu et relu tout ce que j'ai tenté et retenté et reretenté de t'exposer, des captures d'écran que j'ai montrées, etc ... Re-relis également l'histoire du sucre et du café.
L'extraction de ces coordonnées-là ne t'apportera RIEN en matière de correction du fait du zoom.
Mais si tu continues à vouloir faire des ronds dans l'eau, ma foi ... continue donc ...
voila le projet abouti
le nom des macros parle lui même
Code:
1
2
3
4 Sub TestUserformDansPlage() r = RectanGleRange(UserForm1, [B3:F12]) With UserForm1: .Show 0: .Left = r(0): .Top = r(1): .Width = r(2): .Height = r(3): End With End Sub
et la fonction RectanGleRangeCode:
1
2
3
4 Sub TestUserformtopleftcell() r = RectanGleRange(UserForm1, [B3]) With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With End Sub
;)Code:
1
2
3
4
5
6
7
8
9
10
11
12 Function RectanGleRange(usf, rng) Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth# With ActiveWindow.ActivePane pttopx = (.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3 'coefficient multiplicateur pixel ecc = (usf.Width - usf.InsideWidth) * pttopx 'epaisseur du cadre*2 lleft = (.PointsToScreenPixelsX(rng.Left) + ecc) / pttopx ttop = (.PointsToScreenPixelsY(rng.Top) + ecc - pttopx) / pttopx Wwidth = IIf(rng.Columns.Count > 1, rng.Width - ecc - pttopx, usf.Width) Hheight = IIf(rng.Rows.Count > 1, rng.Height - ecc - pttopx, usf.Height) End With RectanGleRange = Array(lleft, ttop, Wwidth, Hheight) End Function
démo
Pièce jointe 277619
Bonjour,
Il est évident que mon usine à gaz me déçois car je comptais trouver dans le net seulement 2 lignes (la déclaration d'une API et sa commande).
Juste une petite remarque, le 15 mai tu me parles de la fonction RangeFromPoint et de boucles mais mon premier module ne tourne qu'avec ces deux éléments.
Merci encore pour cette étude
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
29
30
31
32
33
34
35 Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long Dim PosXRow, PosYCol, N_PosXRow, N_PosYCol '@@@=== DEB TEST ==== Sub TEST(): N_PosXRow = 0: N_PosYCol = 0: PosXRow = 0: PosYCol = 0 SelCelROW = 10: SelCelCOL = 5 '<<<===== CIBLE Cells(SelCelROW, SelCelCOL).Select Positionner_CURSEUR_CELL SelCelROW, SelCelCOL: End Sub '==== FIN TEST ===@@@ Sub Positionner_CURSEUR_CELL(SelCelROW, SelCelCOL): ScreenWidth = 1600: ScreenHeight = 900 PosYColRD = (Application.Top * 1.33) + (ActiveWindow.Top * 1.33) For N_PosYCol = PosYColRD + 100 To ScreenHeight - 20: CelRD = "" On Error Resume Next: CelRD = ActiveWindow.RangeFromPoint(200, N_PosYCol).Address If Trim(CelRD) = "" Then GoTo N_Row If Left(CelRD, 1) = "$" Then CelRD = Mid(CelRD, 2) Pos$ = InStr(CelRD, "$"): If Pos$ > 1 Then Row = Val(Mid(CelRD, Pos + 1)) If SelCelROW = Row Then N_PosYCol = N_PosYCol + (Range(CelRD).RowHeight * 1.33) - 7: PosYCol = N_PosYCol GoTo PosYColTrouvee_ChercherPosXRow End If N_Row: Next N_PosYCol '------------------------------------------------------------------------------------- PosYColTrouvee_ChercherPosXRow: PosXRowRD = (Application.Left * 1.33) + (ActiveWindow.Left * 1.33) For N_PosXRow = PosXRowRD + 50 To ScreenWidth - (PosXRowRD + 1): CelRD = "" On Error Resume Next: CelRD = ActiveWindow.RangeFromPoint(N_PosXRow, N_PosYCol).Address If Trim(CelRD) = "" Then GoTo N_Col CoL = Range(CelRD & 1).Column: If CoL < 1 Then GoTo N_Col If SelCelCOL = CoL Then N_PosXRow = N_PosXRow + 10: PosXRow = N_PosXRow: SetCursorPos PosXRow, PosYCol: End End If N_Col: Next N_PosXRow End Sub
si tu veux
ce que j'ai voulu dire avec range from point c'est que puisque tu boucle sur un chiffre avec les api autant s'en passer
tu prend par exemple
x=application.left +activewindows.left+au hasard 100
et tu boucle sur y step 1 en testant rangefrompoint(x,y)
et tu fait pareil pour y après
au pire la boucle dure 1pixel*ta résolution écran large et inversement pour le top
autant dire immédiat
mais!!!! avec ma méthode avec pointstoscreenpixels (x/y)sur tout les pcs que j'ai pu essayer donne un résultat nickel
avec ou sans displayheading, ruban, activewindow flottante ou pas ,application fenêtrée placée au hasard , zoom ou pas zoom, affichage Windows amélioré ou pas
et elle te donne même le rectangle en points d'une plage de cellule[
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) / 2) * pttopx '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
Tu y es presque, Patricktoulon. Presque, car décalages (selon les cas) d'environ 3 pixels tant en hauteur qu'en largeur.
La cause ? je te l'ai dite plus haut :
1) seule une partie de l'écran subit le zoom
2) ton code ne "zoome" pas les bordures.
Mais c'est déjà beaucoup mieux que ce que tu avais fait avant.
oui chez moi c'est inperceptible
en supprimant l'application des deux zomm a ecc on gagne encore des milimilimillieme de précision et appliquant
le coefficient sans le(zoom window(affichage résolution 125% ) )donc 1.3333333333 soit 4/3 qui est une constante
j'
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 '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
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
quel était la cellule ciblée?
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
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 faiteCode:
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
pour voir
ok je regarde tout ça, je te tiens au courant, merci
Tu peux nous dire ce que cela veut dire, s'il te plait, patricktoulon ?Citation:
adapte le a toi
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
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
je ne sais pas quoi te dire de plus,
ta superbe démo en poste 96 chez moi ça ne marche pas
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. ;).Citation:
ben ca veut dire ajoute ou enlevé ce qui faut
EDIT : je te l'ai déjà fait observer (mon message n° 69 d'il y a déjà une semaine).
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
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 ...)Citation:
il y a donc un paramètre que l'on ignore
Tu y seras encore dans quelques mois, si tu n'en tiens pas compte.
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
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
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
Pièce jointe 279008Code:
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
oui avec les api je connais
ben tien si tu veux rire fait un msgbox x ou y tu va voir mort de rire
1.333333333
en modifiant ton code regarde, je sais pas plus mais c'est mieux
Pièce jointe 279012Code:
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
c'est du pif j'avoue mais si ça te donne une idée de ce qui va pas
regarde ce que ca donne chez moi
Pièce jointe 279017