Autres [Résolu]Affichage userform sur cellule ou activX version simplifiée a tester

[patricktoulon]

bonjour suite a deux discussions ressentes j'ai repris ma méthode et je l'ai simplifiée
normalement avec cette méthode on est dédouané du calcul et prise en charge du freezepane et des scrollbars H et V

aucune Api window ou gdi !!
aucun chiffre en dur dans le code !!!
aucun calcul des scroll ou du freezepane
et l'userform est contraint dans le périmètre de la fenêtre application si il le dépasse
vous voulez bien tester
cellule a jumeler

activx a jumeler

 

[Roland_M]

re

si j'avais compris !
alors ce que je comprend pas c'est pourquoi ça marche pas chez toi avec 120 si la fonction donne bien cette valeur, sinon ça sert à rien

encore une fois, peux tu me répondre à ceci:
dans ton dernier code "New test .. " au post#98
je dois pas encore être réveillé, mais je vois pas où ni comment insérer l'objet !? "

 

[patricktoulon]

re
insérer quoi ?tu lance la sub dans chaque sheets c'est tout et normalement l'userform doit ce positionner au top left de la première cellule mobile
en toute circonstance chaque sheets a les split différent zoom différent, scroll différent
en fait c'est une base 0 grille mobile (visiblerange)

 

[patricktoulon]

ca ne marche pas parce que l'application excel a son propre zoom et n'applique pas le dpi a tout ces elements
on y peut rien je suis obligé de garder ma version initiale
mais je garde la tienne (96) et cell de danreb si j'arrive a la sortir de l'usf pour la mettre dans une fonction séparé

 

[Roland_M]

re

oui ça j'ai bien vu que ça position haut/gauche zone mobile !
mais moi je voulais savoir comment j'insère ce code pour positionner sur la cellule cliqué comme on fait depuis le début !?

à propos du dpi chez moi c'est pas 1.3333 mais 1.60

 

[patricktoulon]

maintenant que saisi mieux le problème des split row column je le refait avec pointtoscreenpixels

me reste les scroll a faire
moins de 15 ligne de code

 

[patricktoulon]

ben tu ajoute respectivement range(premiere cellulemobile,obj).height et width a leur contexte et tu devrait avoir ton userform en bottom et right

 

[Roland_M]

ben tu ajoute respectivement range(premiere cellulemobile,obj).height et width a leur contexte et tu devrait avoir ton userform en bottom et right

c'est justement ça qui m'échappe !? (je dois être trop bête !)
peux tu me donner l'exemple concret avec ton code du post#98 "New test . . ." merci d'avance

 

[patricktoulon]

ben c'est un peu mon probleme comme je l'ai demandé plus haut
comment identifier la dernière ligne ou colonne des split
c'est de ca dont j'ai besoin surtout pour les split scrollé
mais je préférerais que tu m'aide sur une version beaucoup beaucoup beaucoup plus simple qui fonctionne chez moi en dpi 96/120 avec 2007 2013 dans W7
je sèche sur le scrollcolumn sinon le reste c'est bon
tu veux bien ?
au vue du code ca devrait pas difficile de trouver mais ca m’échappe levé a 4h du matin un peu le cerveau endolori
sans scrollcollumn ca fonctionne

Sub test2(obj As Object)

    Dim Z#, EcX#, EcY#, L1#, T1#, nextcolfreeze#, nextrowfreeze#, H#, L#
    With ActiveWindow
        Z = (ActiveWindow.Zoom / 100)
        EcX = 4 / Z
        EcY = 3 / Z
        L1 = (.ActivePane.PointsToScreenPixelsX(obj.Left) / PtoPx) * Z
        T1 = .ActivePane.PointsToScreenPixelsY(obj.Top) / PtoPx * Z

        nextcolfreeze = 5 ' je suis obligé de les coder en dur splitrow donne 3 pour les 3 colonnes visible (je veux 5)
        nextrowfreeze = 6 ' il faudrait que ce soit pareil ici au cas ou des rows dans le splitrow seraient scrollées


        If obj.Column <= nextcolfreeze Then L1 = (obj.Left + (.ActivePane.PointsToScreenPixelsX(0) / PtoPx)) * Z
        If obj.Row < nextrowfreeze Then T1 = (obj.Top + (.ActivePane.PointsToScreenPixelsY(0) / PtoPx)) * Z

        If .ScrollRow > 1 + nextrowfreeze And obj.Row <= nextrowfreeze Then 'ca fonctionne 
            H = Range(Cells(nextrowfreeze + 2, 1), .VisibleRange.Cells(1)).Height * Z
            T1 = T1 + H
            
        End If

        If .ScrollColumn > 1 + nextcolfreeze And obj.Column <= nextcolfreeze Then' ca fonctionne pas 
            L = Range(Cells(nextcolfreeze + 2, 1), .VisibleRange.Cells(1)).Width * Z
            L1 = L1 + L
            'MsgBox h
        End If


    End With

    With UserForm1
        .Show 0
        .Left = L1 + EcX
        .Top = T1 + (EcY * Z)

    End With

End Sub

le but est toujours top et left cell

 

[Roland_M]

re

ok, mais là j'ai ma bourgeoise qui me rappel qu'il est l'heure de partir, sommes invité chez des amis !
en attendant bon dimanche !

 

[Dranreb]

Bonjour.

à propos du dpi chez moi c'est pas 1.3333 mais 1.60

Tu m'inquiètes là, avec ça. Aurais-je fini par virer à tort quelque chose qu'il fallait garder, à force de toujours voir partout que 3 points correspondaient toujours à 4 pixels ?
Qu'est ce que ce code affiche chez toi ? :

Option Explicit
   #If VBA7 Then
Private Declare PtrSafe Function GetDC& Lib "user32.dll" (ByVal hWnd&)
Private Declare PtrSafe Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
   #Else
Private Declare Function GetDC& Lib "user32.dll" (ByVal hWnd&)
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
      #End If
Sub Test()
MsgBox GetDeviceCaps(GetDC(0), 88) / 72 & " pixels par point horizontalement," & vbLf _
     & GetDeviceCaps(GetDC(0), 90) / 72 & " pixels par point verticalement.", vbInformation
   End Sub

 

[patricktoulon]

re
@danreb
---------------------------
Microsoft Excel
---------------------------
1,66666666666667 pixels par point horizontalement,
1,66666666666667 pixels par point verticalement.
---------------------------
OK
---------------------------

 

[patricktoulon]

@danreb
tu va comprendre test cela et regarde l’aberration
et c'est toujours la même cellule

si je me souviens bien ca fait quelques années deja c'etait le zoom 80 qui était le plus proche de la réalité a l’écran jusqu'a zoom 160

Sub test()
Dim i As Double
For i = 50 To 250 Step 10
ActiveWindow.Zoom = i

Debug.Print "zoom" & i & "  " & Cells(4, 3).Width * (ActiveWindow.Zoom / 100)

Next
End Sub

chez moi en 120 dpi

zoom50 31,2
zoom60 37,44
zoom70 43,68
zoom80 49,92
zoom90 56,16
zoom100 62,4
zoom110 68,64
zoom120 74,88
zoom130 81,12
zoom140 87,36
zoom150 93,6
zoom160 99,84
zoom170 106,08
zoom180 112,32
zoom190 118,56
zoom200 124,8
zoom210 131,04
zoom220 137,28
zoom230 143,52
zoom240 149,76
zoom250 156

 

[patricktoulon]

pour info le post 113 etait pas bon j'ai corrigé quelques erreurs

Sub test2(obj As Object)

    Dim Z#, EcX#, EcY#, L1#, T1#, nextcolfreeze#, nextrowfreeze#, H#, L#
    With ActiveWindow
        Z = (ActiveWindow.Zoom / 100)
        EcX = 2
        EcY = 3
        L1 = (.ActivePane.PointsToScreenPixelsX(obj.Left) / PtoPx) * Z + EcX
        T1 = .ActivePane.PointsToScreenPixelsY(obj.Top) / PtoPx * Z
        
        nextcolfreeze = Cells(, .SplitColumn).Column   
        nextrowfreeze = Cells(.SplitRow, 1).Row    
        Left0 = (.ActivePane.PointsToScreenPixelsX(0) / PtoPx)

        If obj.Column <= nextcolfreeze Then L1 = (obj.Left + (.ActivePane.PointsToScreenPixelsX(0) / PtoPx)) * Z
       
 If obj.Row < nextrowfreeze Then T1 = (obj.Top + (.ActivePane.PointsToScreenPixelsY(0) / PtoPx)) * Z

        If .ScrollRow > 1 + nextrowfreeze And obj.Row <= nextrowfreeze Then
            H = Range(Cells(nextrowfreeze + 2, 1), .VisibleRange.Cells(1)).Height * Z
            T1 = T1 + H

        End If

        If .ScrollColumn >= nextcolfreeze And obj.Column <= nextcolfreeze Then
            L1 = (obj.Left * Z) + Left0 + (EcX * Z)

        End If


    End With

    With UserForm1
        .Show 0
        .Left = L1 + EcX
        .Top = T1 + (EcY * Z)

    End With

End Sub

Private Function PtoPx()
    With ActiveWindow.ActivePane:
        PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
    End With
End Function

 

[Dranreb]

Je vais remettre les API, et espérer que, pour tous les DPI utilisés en pratique, 3 points correspondent toujours à un nombre entier de pixels.
Mes bouts de code :

   #If VBA7 Then
Private Declare PtrSafe Function GetDC& Lib "user32.dll" (ByVal hWnd&)
Private Declare PtrSafe Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
   #Else
Private Declare Function GetDC& Lib "user32.dll" (ByVal hWnd&)
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
      #End If

Dim … , Zom As Double, Px72 As Long, Trnq As Long

      Zom = ActiveWindow.Zoom / 100
      Px72 = GetDeviceCaps(GetDC(0), 88)
      If ActiveWindow.FreezePanes Then
         Lft = Obj.Left: Trnq = Int(Lft / 3) * 3
         Lft = ActiveWindow.ActivePane.PointsToScreenPixelsX(Trnq) * 72 / Px72 + (Lft - Trnq)
      Else
         Lft = ActiveWindow.PointsToScreenPixelsX(Int(Obj.Left * Zom * Px72 / 72 + 0.5)) * 72 / Px72
         End If
      Px72 = GetDeviceCaps(GetDC(0), 90)
      If ActiveWindow.FreezePanes Then
         Top = Obj.Top: Trnq = Int(Top / 3) * 3
         Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(Trnq) * 72 / Px72 + (Top - Trnq)
      Else
         Top = ActiveWindow.PointsToScreenPixelsY(Int(Obj.Top * Zom * Px72 / 72 + 0.5)) * 72 / Px72
         End If
      Rgt = Lft + Obj.Width * Zom: Bot = Top + Obj.Height * Zom

Mais c'est regrettable d'avoir 5/3 pixels par point, je ne voudrais certainement pas de ça. Les divisions par 5 de nombres non multiples de 5 ne tombent jamais juste en Double, contrairement à celles par 4 :
=1/4 est noté de façon à représenter exactement 2^-2 soit 0,25 tandis que
=1/5 est noté tel que valant en réalité 3602879701896397 / 2^54 soit 0,200000000000000011102230246251565404236316680908203125
qui est le plus proche possible de 0,2.

 

[patricktoulon]

re
c'est normal
1 point est = a 1.333333333333333 pixel
en dpi 96 donc 100 ca donne la meme chose
en dpi 120 donc 125%
ca donne 1.333333333333333 * 1.25=1.66666666666667
attention on parle que d'affichage 1 pixel restera toujours 1 pixel ca ne change pas c'est juste un coeff d'affichage
peut tu donner le code entier de ta fonction

on pourait tout aussi bien calculer tout en 96 et applique le coeff a la fin du moins je crois