extrait de la version 5 du hook
c'es t pas bon chez moiOk merci, 3 pixels de décalage. Pas bon.
Je pense qu'il faut remplacer Top = Top + 17 par Top = Top + 16 pour par Top = Top + 16.5
Function getControlRectangleForM(obj As Object) As RECT
Dim LfT As Double, Rgt As Double, Top As Double, P As Object, PInsWidth As Double, PInsHeight As Double, z#
Dim K As Double, r As RECT, uu, ItemSize#
LfT = obj.Left: Top = obj.Top: Set P = obj.Parent
Do
PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight: If TypeOf P Is MSForms.Page Then Set P = P.Parent
K = (P.Width - PInsWidth) / 2: LfT = (LfT + P.Left + K): Top = (Top + P.Top + P.Height - K - PInsHeight)
If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
Set P = P.Parent
Loop
With ActiveWindow.Panes(1)
z = .Parent.Zoom / 100.01
r.Left = .PointsToScreenPixelsX(LfT / z) - .PointsToScreenPixelsX(0)
r.Top = .PointsToScreenPixelsY(Top / z) - .PointsToScreenPixelsY(0)
r.Right = Round(r.Left + (.PointsToScreenPixelsX(obj.Width / z) - .PointsToScreenPixelsX(0)), 2)
r.Bottom = Round(r.Top + (.PointsToScreenPixelsY(obj.Height / z) - .PointsToScreenPixelsY(0)), 2)
'If TypeName(obj) = "ComboBox" Then
'calcul du rectangle présumé du child de la combo
' Set uu = USFForm.Controls.Add("forms.label.1", "uu")
' With uu
' .Height = 1: .Width = 1: .Font.Size = obj.Font.Size: .Font.Name = obj.Font.Name: .Font.Bold = obj.Font.Bold
' .Caption = "A": .BorderStyle = 1: .BackColor = vbYellow
' .AutoSize = True
' ItemSize = .Height - 1
'End With
' USFForm.Remove "uu"
' r.Bottom = r.Bottom + (((ItemSize) * obj.ListRows) * Ppx)
'r.Bottom = r.Bottom + ((ItemSize * (obj.ListRows - IIf(obj.Font.Size < 9, 1, 0)) - 2) * Ppx)
'r.Top = r.Top + (obj.Height * Ppx)
'End If
End With
getControlRectangleForM = r
End Function
Par contre je ne vois pas ce que le Zoom vient faire dans cette affaire.
Je corrige mon code et je reviens.
Non, pour moi le Pan.PointsToScreenPixels tient compte du zoom, pas besoin d'en rajouter. Mais bon...faut il que je ré explique ?
purée de coquin de sort tu va me rendre chèvre toiNon, pour moi le Pan.PointsToScreenPixels tient compte du zoom, pas besoin d'en rajouter. Mais bon...
et comme tu peux le voir j'utilise des propriété width et height pas des 16.5 ou 17 ou je ne sais quoiPar contre je dois reconnaître que sans ton code sur les Pages & MultiPages je ne m'en serais jamais sorti. Merci pour ce petit trésor de calcul.
Sub testconvertpixel()
Dim mavaleurPoint, mavaleurPix, z#, texte$
mavaleurPoint = 60
With ActiveWindow.Panes(1)
'test 1
.Parent.Zoom = 100 ''zoom normal à 100%
mavaleurPix = .PointsToScreenPixelsX(mavaleurPoint) - .PointsToScreenPixelsX(0)
texte = texte & "TEST 1 a zoom 100%--> 60 en pixel font : " & mavaleurPix & vbCrLf & vbCrLf
'test 2
.Parent.Zoom = 80 'zoom à 80%
mavaleurPix = .PointsToScreenPixelsX(mavaleurPoint) - .PointsToScreenPixelsX(0)
texte = texte & "TEST 2 a zoom 80%--> 60 en pixel font : " & mavaleurPix & vbCrLf & "là c'est beaucoup moins bien dejà " & vbCrLf & vbCrLf
texte = texte & "maintenant prise en compte du zoom dans le calcul" & vbCrLf & vbCrLf
'test 3 'on inclu le zoom dans le calcul
.Parent.Zoom = 80 'zoom à 80%
z = .Parent.Zoom / 100
mavaleurPix = Round(.PointsToScreenPixelsX(mavaleurPoint / z) - .PointsToScreenPixelsX(0))
texte = texte & "TEST 3 a zoom 80% inclu dans calcul--> 60 en pixel font : " & mavaleurPix & vbCrLf & "l ah ben oui ca va beaucou mieux déjà " & vbCrLf & vbCrLf
'test 4 'on inclu le zoom dans le calcul
.Parent.Zoom = 100 'zoom à 80%
z = .Parent.Zoom / 100
mavaleurPix = Round(.PointsToScreenPixelsX(mavaleurPoint / z) - .PointsToScreenPixelsX(0))
texte = texte & "TEST 4 a zoom 100% inclu dans calcul--> 60 en pixel font : " & mavaleurPix & vbCrLf & "ahh.. ben oui a 80 ou 100 % ca fonctionne bien " & vbCrLf & vbCrLf
End With
MsgBox texte
End Sub