Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Positionnement d'un UserForm

Papounet59560

XLDnaute Nouveau
Bonjour,
Je vous expose mon problème .. Le cellule A1 a pour position top 0 et left 0 par rapport à la feuille
Peut on mettre un UserForm ayant le Left et Top sur la position Left et Top de la cellule.
Merci à vous
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Mes UFmCalend sont équipés d'une méthode Posit pour les positionner.
VB:
Public Sub Posit(ByVal Obj As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
Rem. ——— Méthode. Vous pouvez au préalable positionner l'UserForm par rapport à quelque chose.
'     Obj: Ce par rapport à quoi vous voulez le positionner. X et Y indiqueront comment :
'     X: -1: Collé au coté gauche, 0: Centré horizontalement, 1: Collé au coté droit.
'     Y: -1: Collé au bord supérieur, 0: Centré verticalement, 1: Collé juste en dessous.
'     Mais si la valeur absolue de X >= 1, Y:=0.9 est une valeur conventionnelle demandant
'        à ce que le bord supérieur du calendrier soit aligné sur celui de Obj.
'     D'autres valeurs entraineront un recouvrement partiel ou un certain éloignement.
'     Mais rien ne vous empêche de rectifier encore ensuite la propriété Left ou Top
'     de l'UFmCalend pour ajouter un interstice en points au bord de l'objet. Mais toujours
'        avant le Show, donc avant utilisation de la méthode Saisie.
'     X et Y sont facultatifs et assumés = 0. Il est donc centré sur l'objet Obj si non précisés.
   Dim Lft As Double, Top As Double, Rgt As Double, Bot As Double, U As Object, UInsWidth As Single, _
      UInsHeight As Single, K As Double, Wnw As Window, P As Long, Pan As Pane, Px72 As Long, Trnq As Long
   If TypeOf Obj Is MSForms.Control Then
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement UserForm, Frame ou Page.
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Multipage n'aura plus les dimensions
         If TypeOf U Is MSForms.Page Then Set U = U.Parent       ' intérieures, mais le Page n'avait que ça.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K
         Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
      Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
   Else
      Set Wnw = ActiveWindow: Set Pan = Wnw.ActivePane
      If Intersect(Pan.VisibleRange, Obj) Is Nothing Then
         For P = 1 To Wnw.Panes.Count: Set Pan = Wnw.Panes(P)
            If Not Intersect(Pan.VisibleRange, Obj) Is Nothing Then Exit For
            Next P
         If P > Wnw.Panes.Count Then Exit Sub ' Abandon si la plage n'est visible nulle part.
         End If
      Px72 = GetDeviceCaps(GetDC(0), 88) ' Nombre de pixels pour 72 points.
      Lft = Obj.Left: Trnq = Int(Lft / 3) * 3
      Lft = Pan.PointsToScreenPixelsX(Trnq) * 72 / Px72 + (Lft - Trnq)
      Px72 = GetDeviceCaps(GetDC(0), 90) ' Nombre de pixels pour 72 points.
      Top = Obj.Top: Trnq = Int(Top / 3) * 3
      Top = Pan.PointsToScreenPixelsY(Trnq) * 72 / Px72 + (Top - Trnq)
      K = Wnw.Zoom / 100: Rgt = Lft + Obj.Width * K: Bot = Top + Obj.Height * K
      End If
   Me.Left = (X * (Rgt - Lft + Me.Width + 6) + Lft + Rgt - Me.Width - 6) / 2 + 3
   If Abs(X) >= 1 And Y = 0.9 Then
      Me.Top = Top
   ElseIf Abs(X) >= 1 And Y = -0.9 Then
      Me.Top = Bot - Me.Height
   Else
      Me.Top = (Y * (Bot - Top + Me.Height + 6) + Top + Bot - Me.Height - 6) / 2 + 3
      End If
   End Sub
Utilise les API :
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
 

Pièces jointes

  • MonCalendrier.xlsm
    179 KB · Affichages: 5

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…