Sub test4(obj As Object, Horizon As Long, Vertical As Long)
Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean
With ActiveWindow
'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 Sub
Z = (ActiveWindow.Zoom / 100): EcX = 4: Set Vr = .VisibleRange 'Coeff zoom , ecart cadre , rangevisible partie mobile
'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 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
Hx = (obj.Height / 2) * Z
L1 = L1 + (Wx * Horizon)
T1 = T1 + (Hx * Vertical)
With UserForm1
.Show 0: .Left = L1: .Top = T1
End With
End Sub
Private Function PtoPx()
With ActiveWindow.ActivePane:
PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
End With
End Function
Sub test_cellule_injecté()
'HORIZON=0=left,1=milieu,2=right
'Vertical = 0 pour top,1 pour milieu,2 pour bottom
test4 Cells(3, 8), 2, 1
End Sub
Sub testggg()
MsgBox 0 + 4 And Int(Val(Application.Version)) > 12
End Sub
Sub test4(obj As Object, Horizon As Long, Vertical As Long)
Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean
With ActiveWindow
'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 Sub
Z = (ActiveWindow.Zoom / 100): Set Vr = .VisibleRange 'Coeff zoom , rangevisible partie mobile
EcX = 4 And Int(Val(Application.Version)) = 12 'ecart cadre
'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 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
Hx = (obj.Height / 2) * Z
L1 = L1 + (Wx * Horizon)
T1 = T1 + (Hx * Vertical)
With UserForm1
.Show 0: .Left = L1: .Top = T1
End With
End Sub
Private Function PtoPx()
With ActiveWindow.ActivePane:
PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
End With
End Function
Sub test_cellule_injecté()
'HORIZON=0=left,1=milieu,2=right
'Vertical = 0 pour top,1 pour milieu,2 pour bottom
test4 Cells(3, 8), 2, 1
End Sub
Sub test4(obj As Object, Horizon As Long, Vertical As Long)
Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean, Op&
With ActiveWindow
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 Sub
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
'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 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
Hx = (obj.Height / 2) * Z
L1 = L1 + (Wx * Horizon)
T1 = T1 + (Hx * Vertical)
With UserForm1
.Show 0: .Left = L1: .Top = T1
End With
End Sub
Poste #178.ok c'est quoi le dernier post bon de ton fichier que j'en récupère la fonction
re
???????????
Sub Essai()
Application.ScreenUpdating = False
With ActiveWindow.ActivePane: PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width: End With
MsgBox PtoPx
Application.ScreenUpdating = True
With ActiveWindow.ActivePane: PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width: End With
MsgBox PtoPx
End Sub
Affiche 2 fois 1,333333333333 chez moi.à vérifier avec ceci: