Discussion :

[deedolith]

Bonjour,

Dans un environnement multi-écran, j'experimente des difficultés à positionner un formulaire dans le coin haut/gauche de la feuille active.
Après recherche, il s'avère que c'est lié au facteur d'échelle de windows.

Comment contourner ce problème ?

[Jean-Philippe André]

Salut,

quel est ton code actuel ?

Est-ce que tes Application.Top ou .Left ne suffisent pas à arriver à tes fins ?

[deedolith]

Ben non,

Application.Top et Application.Left correspondent au coin supérieur gauche de la fenêtre Excel, le formulaire s'affiche sur le ruban (et j'utilise ce dernier).
C'est la première cellule visible qui m'intéresse.

Je poste un extrait de code dès que possible.

[deedolith]

J'ai le code suivant

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
Sub Test()
    Dim Rect As Rect
     Rect = GetCellRect(ActiveWindow.ActivePane.VisibleRange.Cells(1))
 
    Dim Frm as Form1
    Set Frm = New Form1
    Frm.Top = Rect.Top
    Frm.Left = Rect.Left
End Sub
 
'// Source: https://github.com/nervgh/vba/blob/master/GetRectForExcel2007Plus/test.xlsm_VBProject/mod_GetRectForExcel2007Plus.bas
' ----------------------------------------
' Returns the cell coordinates in points relative to the screen
'
' @param {Object} Target the cell
' @return {Rect} the cell coordinates
' ----------------------------------------
Public Function GetCellRect(ByVal Target As Excel.Range) As Rect
    Const FunctionName As String = "GetCellRect"
    Dim ErrorLogger As ErrorLogger
    Set ErrorLogger = Factory.CreateErrorLogger(ModuleName, FunctionName)
 
    With ActiveWindow
        Set Target = Target.MergeArea
 
        Dim Index As Integer
        For Index = 1 To .Panes.Count
            If Not Intersect(Target, .Panes(Index).VisibleRange) Is Nothing Then
                Dim Rect As Rect
                With .Panes(Index)
                    Rect.Left = PixelsToPoints(.PointsToScreenPixelsX(Target.Left))
                    Rect.Top = PixelsToPoints(.PointsToScreenPixelsY(Target.Top))
                End With
                Rect.Right = Target.Width * .Zoom / 100 + Rect.Left
                Rect.Bottom = Target.Height * .Zoom / 100 + Rect.Top
                GetCellRect = Rect
                Exit Function
            End If
        Next
    End With
End Function

Avec un facteur d'échelle de 100%, pas de problème.
Avec un facteur autre, le formulaire est mal positionné.

[joe.levrai]

Bonjour,


j'ai cette approximation qui traine dans mes tiroirs

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
Option Explicit
Declare PtrSafe Function GetDC& Lib "user32.dll" (ByVal hwnd&)
Declare PtrSafe Function GetDeviceCaps& Lib "gdi32" (ByVal hDC&, ByVal nIndex&)
 
Sub position_usf(usf, cel)
    ' 1 inch = 72 points for usually 96 or 120 dpi
    Dim x As Double, y As Double
    x = GetDeviceCaps(GetDC(0), 88) / 72
    y = GetDeviceCaps(GetDC(0), 90) / 72
    With usf
        .StartUpPosition = 0
        .Left = (ActiveWindow.PointsToScreenPixelsX(cel.Left * x) * 1 / x)
        .Top = (ActiveWindow.PointsToScreenPixelsY(cel.Top * y) * 1 / y)
    End With
    ActiveWindow.ScrollRow = cel.Row
    ActiveWindow.ScrollColumn = cel.Column
End Sub

A utiliser :

Code :

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

1
2
3
Private Sub UserForm_Activate()
    position_usf Me, Cells(1, 1)
End Sub

[deedolith]

Ca fait le café.

Merci.