Option Explicit
Public tablo
'fonction show perso incluant des parametres
Public Function ShowX(arr, Optional rng As Range = Nothing)
With ufListbox
.tablo = arr
.Show 0
End With
End Function
Private Sub Combo_Change()
With Combo
If .ListIndex > -1 Then MacomboBox_change .value, .ListIndex
End With
Unload Me
End Sub
Private Sub UserForm_Activate()
Dim cel As Range
Set cel = ActiveCell
Combo.List = tablo
Nocaption
placementRange cel
End Sub
Private Sub Nocaption()
Dim hwnd&, h&
h = Me.Combo.Height
hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94080080 & ")") 'api SetWindowLongA
Me.Height = 0
Me.Width = Combo.Width - 4
Combo.Width = Me.InsideWidth
Combo.Height = Me.InsideHeight
End Sub
Private Function placementRange(Obj As Object)
'function put Userform into range périmeter by patricktoulon (france) exceldownloads forum)
'see my calandar
If Obj Is Nothing Then Exit Function
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: Ok = IIf(Not Intersect(.Panes(I).VisibleRange, Obj) Is Nothing, True, Ok): 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
L1 = (.ActivePane.PointsToScreenPixelsX(Int(Obj.Left)) / PtoPx) * z + EcX 'placement partie mobile
T1 = .ActivePane.PointsToScreenPixelsY(Int(Obj.Top)) / PtoPx * z + EcX
With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With 'limite splitrow et splitcolumn
If .SplitRow > 0 Then 'placement 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 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 * 0
HX = (Obj.Height / 2) * z * 0
L1 = L1 '+ (Wx)
T1 = T1 '+ (HX)
If L1 > Application.Left + Application.Width - Me.Width Then L1 = Application.Left + Application.Width - Me.Width - 15
If T1 > Application.Top + Application.Height - Me.Height Then T1 = Application.Top + Application.Height - Me.Height - 15
With Me: .Left = L1: .Top = T1: End With
End Function