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

[patricktoulon]

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

 

[patricktoulon]

re
merci @Phil6970
c'est bizarre que h1 ne soit pas capté tu a le même résultat que @Cthi160
je vais modifier pour arrêter les boucles automatiquement ca réduit la capacité de redressement mais bon on aura un aperçu de ce qui se passe chez vous au moins

 

[patricktoulon]

re
celui là s’arrête au delà de 50 point d’écart ce qui normalement est suffisant pour redresse les quelques points
le résultat que tu obtiendra m'en diras un peu plus

 

[Phil69970]

Re

Voila ce que cela donne chez moi

@Phil69970

 

[patricktoulon]

d'accords il ne s’arrête pas par ce que le windowfrompoint de capte pas le handle
bloque le re dressage avec un exit en debut de sub
pour voir ou est le userform au départ

 

[ChTi160]

Bonsoir
ce que ça donne chez moi !
manque pas grand chose . Lol
Merci
Jean marie

 

[Phil69970]

Re

Idem avec les 2 boutons mais c'est logique.....vu que l'on sort avec exit sub

@Phil69970

 

[ChTi160]

Re
Oui ! mais moi c'est presque Bon Lol
Jean marie

 

[patricktoulon]

@Phil69970
ok bizarre elle est plus basse et plus a droite ça devrait coller
alors je crois que tu n'a pas de décalage
chez toi ceci doit aller pilpoil

dans un userform

Private Sub UserForm_Activate()
 Dim PtoPx#, z#, L#, t#, Cel As Range
    Set Cel = [C3]
     z = ActiveWindow.Zoom / 100
   With ActiveWindow.ActivePane
        PtoPx = (.PointsToScreenPixelsX(72) - .PointsToScreenPixelsX(0)) / 72
           L = (.PointsToScreenPixelsX(Cel.Left) / PtoPx) * z
     t = (.PointsToScreenPixelsY(Cel.Top) / PtoPx) * z
     End With
Me.Move L, t
End Sub

 

[ChTi160]

Re
moi là c'est l'inverse !
Bon en Haut pas a gauche Lol
Jean marie

 

[Phil69970]

Re

Avec le code du post 173

@Phil69970

 

[patricktoulon]

franchement j'y comprends plus rien c'est pas cohérent tout ça
un coup oui un coup non
bon pour le problème ce Phil69970 j'ai compris
h1 est pris apres le show et il y a déjà le userform donc la bascule h1<>h2 ne peut pas coller forcément
il faut que je trouve une autre bascule pour démarrer du handle (h1) en tant qu'excel
chez toi @ChTi160 c'est complètement incohérent alors je sais pas

 

[patricktoulon]

Re

Avec le code du post 173

Regarde la pièce jointe 1121943

@Phil69970

bon ben là c'est la cata
autrement dit tu dois avoir la différence comme certain (.activepane ou pas dans le code )

 

[ChTi160]

Re
Pour te réconforter Patrick
Chez moi, c'est presque bon dans le deux Cas Lol
Courage Patrick!
Peut-être un Mix des deux pour moi Lol
On est avec toi !
Jean marie

 

[patricktoulon]

re
tout le monde a la meme enseigne on demarre plus bas et plus a droite de 15 points de plus

Public cel As Range
Public Function WindowXYFromPoint(x, y): WindowXYFromPoint = ExecuteExcel4Macro("CALL(""user32"",""WindowFromPoint"",""JJJ""," & x & ", " & y & ")"): End Function
Public Function ShowOnCell(cel As Range, Optional modal As Boolean = vbModal)
    With UserForm2: Set .cel = cel: .Show modal: End With
End Function

Function placeOnRange(RNG As Range)
    Dim h2&, H1&, PtPx#, EcX&, Ecy&
    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)
      
    End With
    EcX = Round(Me.Width - Me.InsideWidth) * PtPx    'ecart maximum toléré par la fonction en pixel
    Ecy = Round(Me.Height - Me.InsideHeight) * PtPx    'ecart maximum toléré par la fonction en pixel
    H1 = WindowXYFromPoint(x, y)
    With Me
        .StartUpPosition = 0
        .Left = (x / PtPx * ActiveWindow.Zoom / 100) + 15       ' je deregle la position exemple je le met à -100 de left
        .Top = (y / PtPx * ActiveWindow.Zoom / 100) + 15      ' je deregle la position exemple je le met à +10 de top
        
    End With
  
    'correction Left
    h2 = WindowXYFromPoint(x, y + Ecy)
    If h2 <> H1 Then
        Do While h2 <> H1 And b < 100: Me.Left = Me.Left + 0.1: h2 = WindowXYFromPoint(x, y + Ecy): b = b + 1: Loop: Me.Left = Me.Left - 1
    Else
        b = 0
        Do While h2 = H1 And b < 100: Me.Left = Me.Left - 0.1: h2 = WindowXYFromPoint(x, y + Ecy): b = b + 1: Loop: Me.Left = Me.Left - 1
    End If
 'correction top
    h2 = WindowXYFromPoint(x + EcX, y)
    If h2 <> H1 Then
        b = 0
       Do While h2 <> H1 And b < 100: Me.Top = Me.Top + 0.1: h2 = WindowXYFromPoint(x + EcX, y): b = b + 1: Loop: Me.Top = Me.Top - 1
    Else
         b = 0
      Do While h2 = H1 And b < 100: Me.Top = Me.Top - 0.1: h2 = WindowXYFromPoint(x + EcX, y): b = b + 1: Loop: Me.Top = Me.Top - 1  'on le repousse donc en bas
    End If
End Function
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////

Private Sub UserForm_Activate()
    
    If cel Is Nothing Then Set cel = [D5]
         placeOnRange cel
    End Sub

 

[Phil69970]

Re

Avec le code du post 179

@Phil69970