Discussion :

[benzoid555]

Bonjour j'utilise vba dans excel2007.

après recherche sur internet, je suis perdu.

quel est l'unité de mesure renvoyé par la methode picture.height

mon image test.bmp fait 114pixel par 104 pixel.
.Picture.Height me retourne 3016
.Picture.Width me retourne 2752


voici mon code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
cwd = CurDir
nom_image = cwd & "\test.bmp"
image.Picture_box.Picture = LoadPicture(nom_image)
With image.Picture_box
    .Visible = True
    .AutoSize = True
 
    hauteur = .Picture.Height
    largeur = .Picture.Width
 
End With

merci

[ucfoutu]

Bonjour,

Je te réponds, mais tu ne vas pas t'en sortir facilement.
Les dimensions de la propriété Picture d'une image sont, sous VBA, exprimées en unités Himetric
3016 (plus exactement 3016,25) unités Himetric = 114 pixels

quant à 104 pixels, leur équivalence en unités Himetric n'est pas exactement 2752, mais 2751,667

Ces 2 transpositions (chiffres) si ton moniteur (et je vois que c'est le cas) a 15 twips par pixel horizontalement et autant verticalement.

Transposer d'une unité à l'autre(entre vbHimetric et vbPixels), n'est pas une petite affaire sous VBA et inclut la prise en compte du nombre de twips par pixel horizontalement et verticalement (en général 15 pour les deux sens, mais peut varier, même si rare aujourd'hui, d'un moniteur à l'autre).

[Qwazerty]

Salut
En vb, il existe TwipsperPixelX/Y, absent bien évidement en vba...
[Edit=Remplacement du lien lien externe]
Voici un code trouvé sur Codes-source.fr

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
'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

[/Edit]
a++
Qwaz

[ucfoutu]

Bonjour, Qwazerty,

Cette détermination ne suffira toutefois pas à transposer les unités Himetric en Pixels...
C'est beaucoup plus complexe que celà ...

Un truc simple vaudra mieux :
Genre mettre l'image dans un contrôle image à sa vraie grandeur (donc Autosize) et prendre les mesures Image1.Width et Image1.Height directement.
Je n'ai pas Excel sous la main, mais il se peut que ces dimensions soient exprimées en Points. Leur transformation en Pixels sera alors moins difficile, mais nécessitera quand même une 1ère transposition en Twips ...

[Qwazerty]

Re
Non mais ...

Code :

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

1
2
PIXELS_X = HIMETRICS / 2540 * (1440 / Screen.TwipsPerPixelX)
PIXELS_Y = HIMETRICS / 2540 * (1440 / Screen.TwipsPerPixelY)

devrait arranger les chose ? non? :p
++
Qwaz

[ilank]

Bonsoir,

Tout dépend de la résolution de l'écran. Du nombre de pixels par pouce. L'unité de mesure Himetric est exprimée en centième de millimètre.
en sachant qu' 1 pouce = 2.54 cm = 1440 twips.

Selon la résolution écran : 96 pixels par pouce
x pixels => x/96 pouces => 2.54 * (x/96) *1000 Himétric
=> 1140 (x/96) Twips


soit selon tes données et une résolution à 96 pixels par pouce
114 pixels => 114/96 pouces => 1.1875 pouces => 3.01625 cm => 1710 twips
104 pixels => 104/96 pouces => 1.0833 pouces => 2.75167 cm => 1560 twips

Récupère la résolution de ton écran
Exemple de code:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Const HWND_DESKTOP =0
Const LOGPIXELSX=88
Const LOGPIXELSY=90
Private Declare Function GetDC lib "user32" (byval hWnd as long) as long
Private Declare Function ReleaseDC lib "user32" (Byval hWnd as long, byval hDC as long) as long
Private GetDeviceCaps lib "gdi32" (byVal hDC as long, byval nIndex as long) as long
 
Public Sub GetPixePerInch(ByRef H_PixelPerInch as long, byRef V_PixelPerInch)
 H_PixelPerInch=GetDiveCaps(GetDC(HWND_DESKTOP), LOGPIXELSX)
 V_PixelPerInch=GetDeviceCaps(GetDC(HWND_DESKTOP), LOGPIXELSY)
End Sub

[benzoid555]

merci pour vos reponses j'y vois plus clair

donc si j'ai bien compris

voici un code qui converti les himetrics en pixel :

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
 
'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
Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hDC As Long) As Long
 
'CONSTANT DECLARATION
Public Const DIRECTION_VERTICAL = 1
Public Const DIRECTION_HORIZONTAL = 0
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Const HWND_DESKTOP = 0
 
 
Public Function himetric_to_pixel(ByRef H As Long, ByRef V As Long)
'cette fonction permet de convertir une taille d'image définie himetric en pixel
Dim H_pixelperinch As Long
Dim V_pixelperinch As Long
 
'on recupère la resolution de l'ecran
H_pixelperinch = apiGetDeviceCaps(apiGetDC(HWND_DESKTOP), LOGPIXELSX)
V_pixelperinch = apiGetDeviceCaps(apiGetDC(HWND_DESKTOP), LOGPIXELSY)
 
H = H * H_pixelperinch / 2540
V = V * V_pixelperinch / 2540
 
End Function

et voici un code qui redimentionne la fenetre en fonction de l'image

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Public Sub affiche_image()
 
Dim hauteur_image As Long
Dim largeur_image As Long
Dim largeur_ecran As Long
Dim hauteur_ecran As Long
 
 
largeur_ecran = GetSystemMetrics(SM_CXSCREEN)
hauteur_ecran = GetSystemMetrics(SM_CYSCREEN)
 
 
 
cwd = CurDir
nom_image = cwd & "\test.bmp"
image.Picture_box.Picture = LoadPicture(nom_image)
With image.Picture_box
    .Visible = True
    .AutoSize = True
    hauteur_image = .Picture.Height
    largeur_image = .Picture.Width
    .Top = 0
    .Left = 0
    test = .Height
    test_2 = .Width
End With
'on convertie la taille en pixel
himetric_to_pixel largeur_image, hauteur_image
 
 
 
 
 
'si image plus grand que l'ecran on utilise les ascenseurs
'sinon on redimentionne la fenetre
 
image.ScrollBars = fmScrollBarsNone
If largeur_image > largeur_ecran Then
    image.Width = largeur_ecran
    image.ScrollBars = fmScrollBarsHorizontal
    image.ScrollWidth = largeur_image
Else
    image.Width = largeur_image
End If
 
If hauteur_image > hauteur_ecran Then
    image.Height = hauteur_ecran
    image.ScrollBars = fmScrollBarsVertical
    image.ScrollHeight = hauteur_image
Else
    image.Height = hauteur_image
End If
 
image.Show
 
End Sub

quelqu'un sait pourquoi ma fenètre est toujours plus large que mon image ?
dans le sens de la hauteur c'est bon .

ps mon ecran fait 1440 x 900 pixel (d'apres les propriété de windows XP), si je dimmentionne une fentre a une largeur de 1440 elle est plus grande que l'ecran.

bizarre, bizarre

[ucfoutu]

Je ne coimprends pas ...

ceci ne fait absolument rien, apparemment, déjà :

Code :

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

himetric_to_pixel largeur_image, hauteur_image

puisque lu appelles la fonction en lui passant des paramètres comme s'il s'agissait d'une simple procédure, d'une part, et que, d'autre part, ta fonction n'est pas rédigée pour retourner une valeur !
Bizarre ...

[benzoid555]

j'ai déclaré les arguments de la fonction par réference,

Code :

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

Public Function himetric_to_pixel(ByRef H As Long, ByRef V As Long)

H dans "himetric_to_pixel" et largeur_image dans "affiche_image" pointe tout les deux vers le meme long, ils ont la meme reference.
Donc lorsque la fonction himetric_to_pixel modifie H, elle modifie donc largeur_image dans affiche_image.

La fonction himetric_to_pixel me permet bien d'obtenir la taille en pixel de mon image "test.bmp".
mais lorsque je redimmentionne le userform contenant l'image à la largeur de l'image "test.bmp", le userform est plus grand que mon image. je suppose que c'est du à mon ecran de type 16/9 ( resolution 1440 * 900) .

ps : le redimentionnement dans la hauteur ne pose pas de problème

[ilank]

Bonjour,

en fait je ne sais de quel objet tu souhaites modifier les dimensions.
Les Userform et les contrôles ont des dimensions exprimés en Points, avec 72 points par pouce.