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

XL 2016 Position d'un formulaire sur une feuille de calcul

JpTac

XLDnaute Nouveau
Bonjour à tous,

j'aimerai pouvoir fixer à un endroit précis de ma feuille de calcul un formulaire lorsque je l'ouvre.
Dans la fenêtre de propriété du formulaire j'ai du mal à trouver cette instruction.
Votre aide me serai très utile.
Cordialement
 

Dudu2

XLDnaute Barbatruc
Bonjour,

Au cas où... Une fonction pour positionner un UserForm par rapport à un objet de la feuille (Range, Contrôle de formulaire, Contrôle ActiveX, Shape, Image, ...).
 

Pièces jointes

  • VBA Positionner UserForm sur un Objet de la feuille.xlsm
    55.5 KB · Affichages: 10

patricktoulon

XLDnaute Barbatruc
bonjour
mon calendrier aussi possède cette propriété

sinon vous avez un topic dans les ressources diverses dédié juste a cela
 

patricktoulon

XLDnaute Barbatruc
je l'avais meme sorti de l'userform en fonction
VB:
Option Explicit

Function GetScreenLeftTopCell(obj As Range, Optional posLeft As Long = 0, Optional posTop As Long = 0)
    Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean, Op&, PtoPx#, I&
    With ActiveWindow
        PtoPx = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        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 Function
        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 grosse bordures 2007 et Windows 7
        '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  si 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  si 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 * posLeft)
    T1 = T1 + (Hx * posTop)
    GetScreenLeftTopCell = Array(L1, T1)
End Function

pour tester
VB:
Sub test()
    Dim pos
    'possibilité d'argumentation pour les positions sur la cellule
    'pos = GetScreenLeftTopCell([H15]) ' en plein sur la cellule
    'ou
    'pos = GetScreenLeftTopCell([H15], 1, 0)    ' à moitié verticalement dans la cellule
    'ou
    'pos = GetScreenLeftTopCell([H15], 0, 1)    ' à moitié horizontalement  dans la cellule
    'ou
    'pos = GetScreenLeftTopCell([H15], 1, 1)    ' à moitié horizontalement et verticalement dans la cellule
    'ou
    'pos = GetScreenLeftTopCell([H15], 0, 2) ' juste en dessous de la cellule
    'ou
    pos = GetScreenLeftTopCell([H15], 2, 0)    ' a droite de la cellule

    With UF1
        .Left = pos(0): .Top = pos(1)
        .Show
    End With
End Sub
 

Dudu2

XLDnaute Barbatruc
@Lyriss113,
Tu as soit cette ressource:
Soit ce fichier joint plus simple s'il ne s'agit que de positionner un UserForm sur un Objet de la feuille.
 

Pièces jointes

  • VBA Positionnement UserForm sur Objet d'une feuille.xlsm
    43.4 KB · Affichages: 5

Discussions similaires

Réponses
0
Affichages
284
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…