Bonjour à tous

Pour ma première contribution, je n'étais pas satisfait du positionnement d'un UserForm au double clic dans une cellule.

Voici une solution qui fait appelle à l'API GetCursorPos qui permet de connaître les coordonnées d'un point sur l'écran. Il suffit donc de mettre les propriétés .Top et .Left sur ces coordonnées et le tour est joué.

Quelques soucis en bas de feuille où une partie du USF était cachée par la barre des tâches. Il a donc fallu trouver sa hauteur avec l'API SHAppBarMessage. Je me suis limité et n'ai pas fait de vérification si la barre des tâches était ailleurs qu'en bas.

Semble fonctionner quelle que soit la résolution, ou le zoom sur la feuille de calcul.
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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
'********************************
'Dans un module standard
' fred65200 - http://www.developpez.net/forums/showthread.php?t=452217
'********************************
Option Explicit
'Declaration de l'api pour la position du curseur
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
 
Public Type PointAPI
    x As Long
    y As Long
End Type
 
Public PtCur As PointAPI
 
'Declaration de l'api pour les dimensions de la barre des tâches pas de test si elle est ailleurs qu'en bas
Public Declare Function SHAppBarMessage Lib "shell32.dll" ( _
   ByVal dwMessage As Long, pData As APPBARDATA) As Long
 
Const ABM_GETTASKBARPOS = &H5
 
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
 
Public Type APPBARDATA
   cbSize As Long
   hwnd As Long
   uCallbackMessage As Long
   uEdge As Long
   rc As RECT
   lParam As Long
End Type
 
 
 Function HauteurTaskBar()
'KPD-Team 1999 - http://www.allapi.net/
'
Dim ABD As APPBARDATA, Ret As Long
SHAppBarMessage ABM_GETTASKBARPOS, ABD
HauteurTaskBar = Trim(Str(ABD.rc.Bottom)) - Trim(Str(ABD.rc.Top))
End Function
 
 
 
'********************************
'Dans le module de code du UserForm1
' fred65200 - http://www.developpez.net/forums/showthread.php?t=452217
'********************************
 
'pour l'obtention de la resolution d'écran en pixels
Private Declare Function GetDC Lib "user32.dll" ( _
  ByVal hwnd&) As Long
Private Declare Function ReleaseDC Lib "user32.dll" ( _
  ByVal hwnd&, ByVal hDC&) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hDC&, ByVal nIndex&) As Long
 
Function ResolEcran(item As Byte) As Variant
Dim lDC&
 Static maResolution
If Not IsArray(maResolution) Then
  ReDim maResolution(1) As Long
  lDC = GetDC(0)                               '    -->  renvoie du contexte d'affichage de l'écran
  maResolution(0) = GetDeviceCaps(lDC, 8&)      '  -->   largeur de l'écran en pixels
  maResolution(1) = GetDeviceCaps(lDC, 10&)     '  -->   hauteur de l'écran en pixels
  lDC = ReleaseDC(0, lDC)
End If
ResolEcran = maResolution(item)
End Function
Private Sub UserForm_Initialize()
 Dim CvtPtPixel As Single
    'conversion des points en pixel
    CvtPtPixel = 0.75
   With Me
        .StartUpPosition = 0
        .Top = PtCur.y * CvtPtPixel
        .Left = PtCur.x * CvtPtPixel
    End With
 
    'Ajustement position Gauche
    If ResolEcran(0) * CvtPtPixel < Me.Left + Me.Width Then
       Me.Left = ResolEcran(0) * CvtPtPixel - Me.Width
    End If
 
    'Ajustement bas de fenêtre
    If ResolEcran(1) * CvtPtPixel - HauteurTaskBar < Me.Top + Me.Height Then
      Me.Top = ResolEcran(1) * CvtPtPixel - Me.Width
    End If
End Sub
 
'********************************
'Dans le module de feuille
' fred65200 - http://www.developpez.net/forums/showthread.php?t=452217
'********************************
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True: GetCursorPos PtCur: UserForm1.Show
End Sub
Cordalement