Autres toutes version excel tester le calendar en mode modal et non modal sur range ou control dans userform

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
j'ai pris le temps ce matin de voir un peu ce que je pourrais faire pour mon calendar
en effet il m'est souvent venu des demandes quand au fait que quand l'object appelant et fils d'un userform non modal
et effectivement mon calendar qui est en mode responsif(MODAL)(se comporte comme un msgbox) n'est pas compatible forcement
le conflit d'affichage d'un usf modal par dessus un usf non modal est déclenché
j'ai donc ici recommencé tout a zero (c'est une ébauche)mais il est parfaitement fonctionnel
dites moi ce que vous en pensez
on verra après pour les couleurs et les fériés les langue et region et tout le tointoin
merci pour les retours et suggestion a venir
 

Pièces jointes

  • calendar light.xlsm
    34.4 KB · Affichages: 42
Dernière édition:

patricktoulon

XLDnaute Barbatruc
@Phil69970
oui bon ben pour 365 on fait péter le thèmes et c'est bon on peut considérer que c'est correcte peut etre ajouter left-0.1
oui jean-marie toi aussi 365 je suppose
re
oui 365 c'est bien ça
VB:
Private Sub UserForm_Activate()
    Set Rng = [D5]
    Debug.Print Me.Height
    Hwnduf = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'handle fenetre active
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & Hwnduf & ", " & -20 & ", " & &H101C0090 & ")")
    'ExecuteExcel4Macro ("CALL(""user32"",""DrawMenuBar"",""JJ"", " & Hwnduf & ")")

    With ActiveWindow.ActivePane
        Z = ActiveWindow.Zoom / 100
        PtPx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72    'coeff pixel
        If Not Rng Is Nothing Then x = .PointsToScreenPixelsX(Rng.Left): y = .PointsToScreenPixelsY(Rng.Top)
    End With
     With Me
        .Left = (x / PtPx * ActiveWindow.Zoom / 100) - 0.1'+ 3  'chez moi
        .Top = (y / PtPx * ActiveWindow.Zoom / 100)' + 3 'chez moi
    End With
Debug.Print Me.Height
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
dans mon château Office365 :
1637236791899.png
 

patricktoulon

XLDnaute Barbatruc
un dernière tentative pour différencier les handles
dans un userform avec 2 textboxs nommés "h1" et "h2"
VB:
Public cel As Range
Public Function WindowXYFromPoint(x, y): WindowXYFromPoint = ExecuteExcel4Macro("CALL(""user32"",""WindowFromPoint"",""JJJ""," & x & ", " & y & ")"): End Function

Function placeOnRange(RNG As Range)
    Dim PtPx#, EcX&, Ecy&, BL#, BH#, q1$, q2$, Lh&, th&
    With ActiveWindow.ActivePane
        PtPx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72    'coeff pixel
        If Not RNG Is Nothing Then x = .PointsToScreenPixelsX(RNG.Left): y = .PointsToScreenPixelsY(RNG.Top)
        Lh = .PointsToScreenPixelsX([A1].Left + 10)
        th = .PointsToScreenPixelsY([A1].Top + 10)
    End With
    h1.Value = WindowXYFromPoint(Lh, th)    'le handle sous un point precis  dans la cellule A1
    With Me
        .StartUpPosition = 0
        .Left = (x / PtPx * ActiveWindow.Zoom / 100)    ' + 50      ' je deregle la position exemple je le met à +50 de left
        .Top = (y / PtPx * ActiveWindow.Zoom / 100)    ' - 50    ' je deregle la position exemple je le met à -50 de top

    End With
    h2.Value = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'handle fenetre active


End Function
Private Sub UserForm_Activate()

   Set cel = [D5]
    placeOnRange cel
End Sub
 

patricktoulon

XLDnaute Barbatruc
bon ben là on peut en déduire windowfrompoint est inopérant chez vous ou tombe dans les choux du terrain du voisin
c'est une des api user32 des plus basique
il faudra que je cherche une autre solution n'ayant pas 365 ça risque d’être long
ça va retarder ma mise a dispo de la nouvelle version du calendar çà