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

 

[patricktoulon]

roland

width  ActiveWindow.Panes(1).visiblerange:NoDernLigZone1 =.cells(.cells.count).row:end with

 

[patricktoulon]

re

Sub test()
With ActiveWindow.Panes(1).VisibleRange
cm = .Cells(.Cells.Count).Column - .Columns.Count
MsgBox " il y a  " & cm & "colonnes scrollées dans le splitcolumn" & vbCrLf & " défalquez " & Range(Cells(1, 1), Cells(1, cm)).Address & "(.width) dans le if scrollcolumn..."
End With
End Sub

 

[Dranreb]

Bonjour.
J'ai maintenant assez confiance en les méthodes PointsToScreenPixelsXY de l'objet Pane approprié pour les utiliser même quand les volets ne sont pas figés. Et ce bien qu'elle exige une valeur entière en points (conformément à son nom) contrairement à celle de l'objet Window où c'est moins gênant qu'elle soit entière puisque ce sont des pixels (en dépit de son nom). Le code de positionnement sur cellule est redevenu assez court.

 

[patricktoulon]

re
bonjour dranreb
oui contrairement a beaucoup qui n’apprécient pas cette fonction, je l'ai toujours utilisé il suffit de connaitre son fonctionnement

connaitre la dimension width d'une cellule en pixel
enpixel= .pointstoscreenpixelsx([A1].width)-.pointstoscreenpixelsx(0)



pareil pour toute mesure toujours enlever le point(0)

 

[Roland_M]

Bien le bonjour à tous les deux,

j'ai mis pour essais la Macro de Dranreb et Patrick !
voir constat dans les remarques sur Feuil1/Feuil2/Feuil3 !

pour alterner les essais de l'un ou l'autre voir ici dans code Userform1

Private Sub UserForm_Activate()
PlaceUserfSurObjPatrick RangAppel
' PlaceUserfSurObjDranreb RangAppel
End Sub

 

[patricktoulon]

bonjour roland
oulah depuis la stratégie a changé
revenons au chose simple
qu'est qui est bon et qui ne demande pas de calcul
et bien tout simplement le placement de l'userform sur la partie mobile avec pointstoscreenpixels ca on en est sur (du moins pour moi ca l'est)
donc
Vr c'est le visiblerange de la partie mobile
(PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) pour le top
(PointsToScreenPixelsX(Vr.cells(1).left / PtoPx) * Z)
on a donc notre userform contre le split row et column (en dessous ou a droite)
il nous reste plus qu'a soustraire (obj,derniere cellule du split) (width pour le left) (height pour le top )
on ajoute EcX
les scrollrow et compagnie on s'en balance comme de l'an 40

voila le code

Sub test4(obj As Object)
    Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range
    With ActiveWindow
        Z = (ActiveWindow.Zoom / 100): EcX = 4: Set Vr = .VisibleRange

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

        With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With

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

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

    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

épicétou

 

[Roland_M]

Bonjour,

ben non, je n'ai pas changé de stratégie, je garde ce qui fonctionne au fil des améliorations !
ce sont les deux macros qui répondent le mieux depuis le début !
c'est ta macro, mais comme tu as du le voir, un problème demeure dans Feuil2 avec volet haut et scroll
puis celle dranreb, de je ne sais plus à quel post#, qui est ok à 100% mais avec API !

bon je vais voir avec cette nouvelle macro !?

EDIT: ce qui change et qui n'influence en rien, c'est l'appel: pour mes essais je me sert de ça: j'aime pas bien le Show 0
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Userform1.PlaceUserfSurCell Target: Cancel = True
End Sub

très simple et efficace !

 

[patricktoulon]

non c'est moi qui est changé de strategie

 

[Roland_M]

j'ai collé ta macro dans mon classeur d'essais comme d'hab !
alors le résultat des courses . . . !?
et bien pour l'instant tout semble ok ! et je n'ai plus le problème de la feuil2 !

si ça se confirme, on a là deux superbes macros !

 

[Roland_M]

petite question,
j'essai de placer l'userf à droite de la cellule .offset(0,1)
ça fonctionne mais pas quand je clic côté gauche zone fixe ! volet verticale !?
je dois corriger où ? ça me fera gagner du temps.

 

[patricktoulon]

re
je viens de tester sur
2007,2013 w7
2007 Xp pro
2013 sur pc portable W10

après faut pas rêver en très gros zoom du genre 350 on commence avoir des petits défauts
c'est du au zoom excel et a l'arrondi dans les calculs même si il y en a pas beaucoup
je vais essayer les int pour voir mais au moins ce code est simple et compréhensible même pour débutants

regarde bien le trait noir de sélection (demo en zoom 350)

 

[patricktoulon]

re
+(obj.width*z)

 

[patricktoulon]

re
attends je vais l'inclure

 

[Roland_M]

merci !
avec ça c'est ok Obj.Offset(0, 1)
L1 = (.ActivePane.PointsToScreenPixelsX(Int(Obj.Offset(0, 1).Left)) / PtoPx) * Z + EcX

mais le test quand colonne < côté gauche je vois pas trop où !? suis fatigué !?
If .SplitColumn > 0 Then . . .

EDIT: j'ai essayé pareil avec offset ici
ça fonctionne mais pas sur la colonne à la limite du volet !?

        If .SplitColumn > 0 Then                                                                                                           'rajout offset
            If Obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(Obj.Offset(0, 1), Cells(Obj.Row, C)).Width * Z) + EcX

 

[patricktoulon]

re
version intra userform et extra userform
option
left milieu right
top milieu bottom