Screen.TwipsPerPixelX équivalent en VBA

[Résolu]
Signaler
Messages postés
99
Date d'inscription
mardi 6 avril 2004
Statut
Membre
Dernière intervention
4 décembre 2008
-
Messages postés
796
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
-
J'aimerais savoir si il y a un équivalent à "Screen.TwipsPerPixelX" dans VBA (Access)


Merci


Antoine

6 réponses

Messages postés
796
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
7
Salut ;O)

Non ! Aucune équivalence.
Mais voici 2 fonctions (à mettre dans un module) qui te feront certainement plaisir :
fTwipsToPixels
fPixelsToTwips

'API DECLARATION
Public Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long

'CONSTANT DECLARATION
Public Const DIRECTION_VERTICAL = 1
Public Const DIRECTION_HORIZONTAL = 0
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Function fTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
' Function to convert Twips to pixels for the current screen resolution
' Accepts:
' lngTwips - the number of twips to be converted
' lngDirection - direction (x or y - use either DIRECTION_VERTICAL or DIRECTION_HORIZONTAL)
' Returns:
' the number of pixels corresponding to the given twips
On Error GoTo E_Handle
Dim lngDeviceHandle As Long
Dim lngPixelsPerInch As Long
lngDeviceHandle = apiGetDC(0)
If lngDirection = DIRECTION_HORIZONTAL Then
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
Else
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
End If
lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
fTwipsToPixels = lngTwips / 1440 * lngPixelsPerInch
fExit:
On Error Resume Next
Exit Function
E_Handle:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function

Function fPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long
On Error GoTo E_Handle

Dim lngDeviceHandle As Long
Dim lngPixelsPerInch As Long
lngDeviceHandle = apiGetDC(0)
If lngDirection = DIRECTION_HORIZONTAL Then
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
Else
lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
End If
lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
fPixelsToTwips = lngPixels * 1440 / lngPixelsPerInch
fExit:
On Error Resume Next
Exit Function
E_Handle:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function

Guy
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 70 internautes nous ont dit merci ce mois-ci

Messages postés
796
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
7
Oups ! Il manque une déclaration API :

Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Guy
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 70 internautes nous ont dit merci ce mois-ci

Messages postés
99
Date d'inscription
mardi 6 avril 2004
Statut
Membre
Dernière intervention
4 décembre 2008

Merci

Antoine
Messages postés
796
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
7
En fait, à relire ta question, ces fonctions n'y répondent pas directement. Elles ne donnent pas une équivalence à TwipsPerPixelX, mais j'ai supposé que tu cherchais à convertir tes Twips en pixels et vice-versa...

Guy
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
29
aucune idée si ça marche en VBa (?)



MsgBox ScaleX(1, vbPixels, vbTwips)



ou



MsgBox ScaleY(1, vbPixels, vbTwips)




Daniel
Messages postés
796
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
7
Daniel > voilà ce qui fait la différence entre VB et VBA. Bcp de fonctions de ce genre sont inexistantes et donc, passer par API est la seule alternative.
ScaleX et ScaleY sont inconnus au bataillon de VBA...

Guy