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: 11

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: 6

Discussions similaires

Réponses
0
Affichages
435

Statistiques des forums

Discussions
314 489
Messages
2 110 133
Membres
110 682
dernier inscrit
mgaudi