pour placer un userform au niveau d'une cellule il y plusieurs choses a prendre en compte
cette sub va prendre en compte l’état de l'affichage de votre application excel en toute circonstances
et un petit exemple d'appel de l'userform
je joins un petit fichier à télécharger en exemple avec 3 feuilles ayant été fractionnées, ligne figé ,freezepane
il suffit de cliquer droit sur une cellule pour afficher le userform
- la position de l'application
- les scrolls vertical et horizontal
- les ligne éventuellement figées qui faussent les calculs
- le fractionnement de fenêtre qui faussent également les calculs
- le freezepane et donc quel pane de l'activewindow qui faussent également les calculs
- la version de l'application
- la version du sytem d'exploitation
- etc..etc..
cette sub va prendre en compte l’état de l'affichage de votre application excel en toute circonstances
VB:
Option Explicit
Public Sub placementRange(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 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 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)
With Me: .Left = L1: .Top = T1: End With
End Sub
VB:
Option Explicit
Sub test()
'option Left
'2 ='a droite de la cellule
'1=au milieu du width de la cellule
'0=la cellule est centré par raport a l'usf
'option Top
'2= en dessous la cellule
'1=milieu du height de la cellule
'0= au top de la cellule
With UF1
.placementRange Cells(24, 8), 2, 0 ' a droite et au top cellule
.Show
End With
End Sub
je joins un petit fichier à télécharger en exemple avec 3 feuilles ayant été fractionnées, ligne figé ,freezepane
il suffit de cliquer droit sur une cellule pour afficher le userform
- Auteur
- patricktoulon
- Version
- 1.0