Discussion :

[patricktoulon]

Bonjour a tous
je suis en train de coder une private sub qui va aller dans toute mes boites de dialogues perso créées avec des userforms
cette private sub est sensée placer mon userform au niveau de l'object(range ou controls activX d'un autre userform) que lui injecte en argument

j'explique
j
'ai une variable PUBLIC dans le userform ellse se nomme"place"

pour loader ma boite de dialog(userform)

je fait :
exemple dans le module du sheets avec l'evenement beforeright_click

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    'If Target.Column = 1 Then
        Cancel = True
        With UserForm1
            Set .place = Target
            .Show
        End With
   Unload UserForm1
 'End If
End Sub

jusque la c'est pas compliqué la variable place devient la target
dans le userform en haut de module j'instancie ma variable

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public place As Object

dans le userform dans le initialyse
je met son StartUpPosition a 0 si place <> nothing

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub UserForm_Initialize()
    If Not place Is Nothing Then Me.StartUpPosition = 0 Else Me.StartUpPosition = 2
End Sub

je peux donc placer ma boite de dialog ou bom me semble

dans le activate si place <> nothing j'appelle donc ma private sub de placement ma boite de dialog

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub UserForm_Activate()
    If Not place Is Nothing Then placement
End Sub

ma private sub de placement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub placement()
    Dim PtoPX#, x#, x2#, y#, y2#, ecW&, ecH&, AWP, ActWVr
    ecW = Me.Width - Me.InsideWidth: ecH = Me.Height - Me.InsideHeight
    Set AWP = ActiveWindow.ActivePane: Set ActWVr = ActiveWindow.VisibleRange: Set app = Application
    Select Case TypeName(place)
    Case "Range"
        If Application.WindowState <> xlMinimized Then
            PtoPX = (AWP.PointsToScreenPixelsY(Cells.Height) - AWP.PointsToScreenPixelsY(0)) / Cells.Height
            x = AWP.PointsToScreenPixelsX(place.Left) / PtoPX    '
            y = AWP.PointsToScreenPixelsY(place.Top) / PtoPX   '
            x2 = (app.Left + app.Width) - ecH: x = IIf(x + Me.Width > x2, x2 - Me.Width, x)
            y2 = (app.Top + app.Height) - ecH * 2: y = IIf(y + Me.Height > y2, y2 - Me.Height, y)
        End If
        Me.Left = x + ecW: Me.Top = y + ecW
    Case "TextBox"
        MsgBox place.Name
    Case "UserForm"
        MsgBox place.Name
    End Select
    Set AWP = Nothing
    Set ActWVr = Nothing
End Sub

le query close bloqué bien entendu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True: Me.Hide: Me.StartUpPosition = 2
End Sub

manque de pot je souhaiterais l'appeler sans la variable place de facon a ce que quand il s'affiche il soit au centre
et c'est la que je n'arrive pas a lui remmetre le starUpPosition a 2 ou 1 voir 3 peu m'importe apres l'avoir affiché avec un target pour place

et donc quand je fait ceci ci dessous il ne s'affiche pas au centre par defaut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test2()
'sans placement
    With UserForm1
           .Show
    End With
    Unload UserForm1
End Sub

quelqu'un a une idée pour palier a ce soucis ca plus d'une heure que je plombe dessus
merci pour les retours