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

 

[Dranreb]

Elle à changé à partir du poste #153 (et encore depuis), mais j'avais vu que tu n'avais par reporté les modifications dans ton classeur comparatif, quelques postes plus loin…

 

[patricktoulon]

dranreb
Px72 = (pan.PointsToScreenPixelsX(72) - pan.PointsToScreenPixelsX(0)) ' / Wnw.Zoom + 0.5

utilser autre chose que la donnée en rouge sera toujours hasardeux d’ailleurs tu démontre toi même le problème du zoom excel avec ton 0.5 qui n'est pas parfait chez moi au rendu visuel se serait plutot 0.380
elle est la la puissance de pointstoscreenpixels tout ce que tu ajoute ou enlève, elle le fait toute seule en fonction de l'affichage de l’écran et a zoom 100%

après on est pas au micron prés

 

[Dranreb]

Non, if faudrait prendre Px72 = Int(100 * (Pan.PointsToScreenPixelsX(72) - Pan.PointsToScreenPixelsX(0)) / Wnw.Zoom + 0.5)
Puisque la taille visible à l'écran dépend du zoom et il faut l'arrondir parce que ce facteur peut être n'importe quoi mais que les cellules sont toujours à des pixels entier en positions et tailles. Mais moi je préfère faire confiance à GetDeviceCaps.

 

[patricktoulon]

ok c'est quoi le dernier post bon de ton fichier que j'en récupère la fonction

perso les api si c'est pas indispensable je préfère m'en passer sachant que je travaille en 32 bit et que pour coder les doubles déclarations 32/64 je suis obligé de faire appel aux autres pour vérifier la partie 64 et la on a "a boire et a manger" comme on dit chez nous

 

[patricktoulon]

re
ajout du Contrôle si obj visible a l’écran
avec sub de test cellule injecté
l'apell dans le shhets reste pareil

Sub test4(obj As Object, Horizon As Long, Vertical As Long)
    Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean
    With ActiveWindow

        'exit si la cellule injecté n'est pas vible a l'ecran
        For i = 1 To .Panes.Count
        If Not Intersect(.Panes(i).VisibleRange, obj) Is Nothing Then Ok = True
        Next
        If Ok = False Then Beep: MsgBox " cette cellule n'est pas visible a l'ecran": Exit Sub


        Z = (ActiveWindow.Zoom / 100): EcX = 4: Set Vr = .VisibleRange 'Coeff zoom , ecart cadre  , rangevisible partie mobile
        
        'placement partie mobile
        L1 = (.ActivePane.PointsToScreenPixelsX(Int(obj.Left)) / PtoPx) * Z + EcX
        T1 = .ActivePane.PointsToScreenPixelsY(Int(obj.Top)) / PtoPx * Z + EcX

        'limite splitrow et splitcolumn
        With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With

        If .SplitRow > 0 Then  'placement  dans le splitrow
            If obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(obj, Cells(R, 1)).Height * Z) + EcX
        End If

        If .SplitColumn > 0 Then 'placement  dans le splitcolumn
            If obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(obj, Cells(1, C)).Width * Z) + EcX
        End If
    End With


    'option de placement :
    Wx = (obj.Width / 2) * Z
    Hx = (obj.Height / 2) * Z
    L1 = L1 + (Wx * Horizon)
    T1 = T1 + (Hx * Vertical)



    With UserForm1
        .Show 0: .Left = L1: .Top = T1
    End With

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

Sub test_cellule_injecté()
'HORIZON=0=left,1=milieu,2=right
'Vertical = 0 pour top,1 pour milieu,2 pour bottom
    test4 Cells(3, 8), 2, 1
End Sub

 

[Roland_M]

re

Patrick, comme tu m'avais demandé, voilà où j'en suis:

le classeur qui me servait d'essais
avec routine PosUserfSurCell de Patrick et Dranreb

le classeur exp de mon calendrier
avec routine PosUserfSurCell de Patrick
avec routine PosUserfSurObj de Dranreb

j'ai fais vite ce matin car là j'ai à faire !
si problème me le signaler, il y a tellement eu de modif . . . .

EDIT: arf on s'est croisé !
de plus encore des modif aïe aïe aïe ...


qu'appelles tu cellule injectée ? et quelle est l'utilité ? merci

 

[patricktoulon]

re
ok tu a adopté ma methode
par contre je pige pas cela
Me.Top = T1 - (4 And Int(Val(Application.Version)) > 12): Me.Left = L1 - (4 And Int(Val(Application.Version)) > 12) '12=2007

chez moi quand je fait

Sub testggg()
MsgBox 0 + 4 And Int(Val(Application.Version)) > 12
End Sub

j'obtiens 0 donc la formule n'est pas bonne

re ok compris c'est "-" donc OK

 

[patricktoulon]

re
je l'ai donc adopté
mais je l’inclut dans le calcul et non dans l'application' on pourra toujours modifier plus facilement le cas echéant

Sub test4(obj As Object, Horizon As Long, Vertical As Long)
    Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean
    With ActiveWindow

        'exit si la cellule injecté n'est pas vible a l'ecran
        For i = 1 To .Panes.Count
            If Not Intersect(.Panes(i).VisibleRange, obj) Is Nothing Then Ok = True
        Next
        If Ok = False Then Beep: MsgBox " cette cellule n'est pas visible a l'ecran": Exit Sub


        Z = (ActiveWindow.Zoom / 100): Set Vr = .VisibleRange    'Coeff zoom ,  rangevisible partie mobile
        EcX = 4 And Int(Val(Application.Version)) = 12 'ecart cadre


        'placement partie mobile
        L1 = (.ActivePane.PointsToScreenPixelsX(Int(obj.Left)) / PtoPx) * Z + EcX
        T1 = .ActivePane.PointsToScreenPixelsY(Int(obj.Top)) / PtoPx * Z + EcX

        'limite splitrow et splitcolumn
        With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With

        If .SplitRow > 0 Then  'placement  dans le splitrow
            If obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(obj, Cells(R, 1)).Height * Z) + EcX
        End If

        If .SplitColumn > 0 Then    'placement  dans le splitcolumn
            If obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(obj, Cells(1, C)).Width * Z) + EcX
        End If
    End With


    'option de placement :
    Wx = (obj.Width / 2) * Z
    Hx = (obj.Height / 2) * Z
    L1 = L1 + (Wx * Horizon)
    T1 = T1 + (Hx * Vertical)



    With UserForm1
        .Show 0: .Left = L1: .Top = T1
    End With

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

Sub test_cellule_injecté()
'HORIZON=0=left,1=milieu,2=right
'Vertical = 0 pour top,1 pour milieu,2 pour bottom
    test4 Cells(3, 8), 2, 1
End Sub

 

[patricktoulon]

re
j'ai eu raison de le mettre dans le calcul pour de futures modifs
c'est pas bon ton principe
W7 et 2013 32 bits j'ai besoins de 4 aussi
ca n'a donc rien a voir avec la version d'office mais bel est bien la version windows
correction

Sub test4(obj As Object, Horizon As Long, Vertical As Long)
    Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean, Op&
    With ActiveWindow
        
        Op = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))) 'number version system
        
        'exit si la cellule injecté n'est pas vible a l'ecran
        For i = 1 To .Panes.Count
            If Not Intersect(.Panes(i).VisibleRange, obj) Is Nothing Then Ok = True
        Next
        If Ok = False Then Beep: MsgBox " cette cellule n'est pas visible a l'ecran": Exit Sub


        Z = (ActiveWindow.Zoom / 100): Set Vr = .VisibleRange    'Coeff zoom ,  rangevisible partie mobile
        EcX = 4 And Op = 6 And Int(Val(Application.Version)) < 16  'ecart cadre


        'placement partie mobile
        L1 = (.ActivePane.PointsToScreenPixelsX(Int(obj.Left)) / PtoPx) * Z + EcX
        T1 = .ActivePane.PointsToScreenPixelsY(Int(obj.Top)) / PtoPx * Z + EcX

        'limite splitrow et splitcolumn
        With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With

        If .SplitRow > 0 Then  'placement  dans le splitrow
            If obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(obj, Cells(R, 1)).Height * Z) + EcX
        End If

        If .SplitColumn > 0 Then    'placement  dans le splitcolumn
            If obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(obj, Cells(1, C)).Width * Z) + EcX
        End If
    End With


    'option de placement :
    Wx = (obj.Width / 2) * Z
    Hx = (obj.Height / 2) * Z
    L1 = L1 + (Wx * Horizon)
    T1 = T1 + (Hx * Vertical)



    With UserForm1
        .Show 0: .Left = L1: .Top = T1
    End With

End Sub

 

[Roland_M]

re et dern !?!?

Il est important de signaler qu'il faut IMPERATIVEMENT mettre au début de Sub
Application.ScreenUpdating = True

sinon les résultats sont = 0 et plantage Div 0 !
faire l'essai en mettant à false pour voir !

par exemple dès le début PtoPx = 0 si False
---------------------------------------
Application.ScreenUpdating = False
With ActiveWindow.ActivePane
PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
End With

 

[patricktoulon]

re
???????????

 

[Dranreb]

ok c'est quoi le dernier post bon de ton fichier que j'en récupère la fonction

Poste #178.
Et les UFmCalend et UFmCalenS ont les directive de compilation qui permettent en principe de tourner en 64 bits.

 

[Roland_M]

re
???????????

tu ne t'es jamais rendu compte ?
c'est très simple à vérifier avec ceci:

Sub Essai()
Application.ScreenUpdating = False
With ActiveWindow.ActivePane: PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width: End With
MsgBox PtoPx
Application.ScreenUpdating = True
With ActiveWindow.ActivePane: PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width: End With
MsgBox PtoPx
End Sub

je m'en suis rendu compte car je met à False au début de mes applications
et quand je faisais des essais avec tes macros avec .PointsToScreenPixelsX/Y . . .
ça marchait pas, et j'avais des plantages sur division/0

EDIT: VOIR ICI au post#905
"Attention également à Application.ScreenUpdating... "

[Toutes versions] Positionner curseur sur une cellule sélectée Windows Excel VBA - Page 46 - Macros et VBA Excel

J'obtiens 8,8,3,1 avec ton test Patrick.

www.developpez.net

RE-EDIT: en plus je viens de m'apercevoir que tu participes à cette discussion !

 

[Dranreb]

à vérifier avec ceci:

Affiche 2 fois 1,333333333333 chez moi.

 

[Roland_M]

salut Dranreb,

alors qu'est ce qui justifie ça !?
à False j'ai 0 ! je ne suis pas fou !

Win 7 64bits Excel 2007 32bits

EDIT: nom de dieu avec 2016 c'est OK, bizarre cette affaire !?