Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel redimensionner image en VBA

redimensionner image en VBA

17 réponses
Avatar
Christophe CAMPAIN
Bonjour à tous,


Y-t-il une possibilité de "retailler" (rééchantillonner) une image par VBA
de manière à adapter son poids à celui de l'affichage dans excel sans
trimbaler tout le poids de l'image d'origine?

Par avance merci pour toute information concernant les manipulations de
fichiers images sous EXCEL, VBA...

@+

Kristof
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Christophe CAMPAIN
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je n'avais
plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne (ensemble du
code + suggestion Michel dans Module UserForm ) et l'image apparait bien
redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN perso
qui ramait suffisement pour voir que le résultat était pas mal... mais pas
éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne parviens pas à
déterminer (en mode débogage) le momment où et pourquoi le userform est
redéssiné (en fait je ne suis pas sur qu'il soit réellement redéssiné, mais
en tout cas le userform apparaît vierge) éffacant ainsi le résultat de
l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et continu
ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition que la
fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage du
Userform (pas facile de décrire ça , quelques copies écran seraient les
bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça ressemble à
du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis pas un
expert en compression d'image, mais les fichiers obtenus sont super light et
idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en 512 x
384

Par contre, j'ai toujours un problème de taille avec ce fichier excel qui
semble emmagasiner toutes les photos chargées lors du traitement et ne se
"Vide" les neurones qu'aprés une fermeture et réouverture complète du
fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que j'ailles
alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le point
dans

Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à mes
besoins


(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples d'utilisation
fournis sur le site (http://www.alphabeta-net.com/VirtualPicture.html)
concernent l'utilisation dans un environnement VB et non VBA d'office.
Je


ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire, module,
autre...) ,si on doit créer un objet VirtualPicture sur un nouveau
formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me heurte à
l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une erreur
et ne


me permet pas de tester le code veritablement. Lorsque je met les lignes
de


code comportant Me en commentaire, tout le reste semble fonctionner
(l'éxécution ne génère pas d'erreur) mais je ne vois absolument rien de
rien...

Si quelqu'un connait un peu le genre de problèmes que l'on rencontre en
essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As Long
Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight, lngNewWidth)
objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight, lngNewWidth)
objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans le
message


de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image "Light"
dans ses

documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait de
redimensionner une image et/ou de la convertir en JPEG ou en GIF, je
ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres formats
d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur Telecharger.com

Il y avait bien une bibliothèque de manipulation des images JPEG chez
Intel, mais j'ai perdu la référence.












Avatar
Michel Pierron
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais péter ton code
ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a écrit dans le
message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je n'avais
plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne (ensemble du
code + suggestion Michel dans Module UserForm ) et l'image apparait bien
redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN perso
qui ramait suffisement pour voir que le résultat était pas mal... mais pas
éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne parviens pas à
déterminer (en mode débogage) le momment où et pourquoi le userform est
redéssiné (en fait je ne suis pas sur qu'il soit réellement redéssiné, mais
en tout cas le userform apparaît vierge) éffacant ainsi le résultat de
l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et continu
ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition que la
fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage du
Userform (pas facile de décrire ça , quelques copies écran seraient les
bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça ressemble à
du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis pas un
expert en compression d'image, mais les fichiers obtenus sont super light et
idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en 512 x
384

Par contre, j'ai toujours un problème de taille avec ce fichier excel qui
semble emmagasiner toutes les photos chargées lors du traitement et ne se
"Vide" les neurones qu'aprés une fermeture et réouverture complète du
fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que j'ailles
alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le point
dans

Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à mes
besoins


(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples d'utilisation
fournis sur le site (http://www.alphabeta-net.com/VirtualPicture.html)
concernent l'utilisation dans un environnement VB et non VBA d'office.
Je


ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire, module,
autre...) ,si on doit créer un objet VirtualPicture sur un nouveau
formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me heurte à
l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une erreur
et ne


me permet pas de tester le code veritablement. Lorsque je met les lignes
de


code comportant Me en commentaire, tout le reste semble fonctionner
(l'éxécution ne génère pas d'erreur) mais je ne vois absolument rien de
rien...

Si quelqu'un connait un peu le genre de problèmes que l'on rencontre en
essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As Long
Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight, lngNewWidth)
objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight, lngNewWidth)
objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans le
message


de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image "Light"
dans ses

documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait de
redimensionner une image et/ou de la convertir en JPEG ou en GIF, je
ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres formats
d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur Telecharger.com

Il y avait bien une bibliothèque de manipulation des images JPEG chez
Intel, mais j'ai perdu la référence.
















Avatar
Christophe CAMPAIN
Salut !

Je vais te transmettre ça par mail parcequ'il y a plusieurs éléments...

Kristof

"Michel Pierron" a écrit dans le message de
news:
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais péter
ton code

ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je
n'avais


plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne (ensemble
du


code + suggestion Michel dans Module UserForm ) et l'image apparait bien
redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN
perso


qui ramait suffisement pour voir que le résultat était pas mal... mais
pas


éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne parviens
pas à


déterminer (en mode débogage) le momment où et pourquoi le userform est
redéssiné (en fait je ne suis pas sur qu'il soit réellement redéssiné,
mais


en tout cas le userform apparaît vierge) éffacant ainsi le résultat de
l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et
continu


ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition que
la


fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage du
Userform (pas facile de décrire ça , quelques copies écran seraient les
bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça ressemble
à


du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis pas
un


expert en compression d'image, mais les fichiers obtenus sont super
light et


idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en 512
x


384

Par contre, j'ai toujours un problème de taille avec ce fichier excel
qui


semble emmagasiner toutes les photos chargées lors du traitement et ne
se


"Vide" les neurones qu'aprés une fermeture et réouverture complète du
fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que
j'ailles


alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As
Long



Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le
point



dans
Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN" a
écrit



dans le
message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à mes
besoins


(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples
d'utilisation




fournis sur le site
(http://www.alphabeta-net.com/VirtualPicture.html)




concernent l'utilisation dans un environnement VB et non VBA
d'office.




Je
ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire,
module,




autre...) ,si on doit créer un objet VirtualPicture sur un nouveau
formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me heurte à
l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une
erreur




et ne
me permet pas de tester le code veritablement. Lorsque je met les
lignes




de
code comportant Me en commentaire, tout le reste semble fonctionner
(l'éxécution ne génère pas d'erreur) mais je ne vois absolument rien
de




rien...

Si quelqu'un connait un peu le genre de problèmes que l'on rencontre
en




essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As Long
Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans le
message


de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image
"Light"






dans ses
documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait de
redimensionner une image et/ou de la convertir en JPEG ou en GIF,
je





ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres
formats





d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur
Telecharger.com






Il y avait bien une bibliothèque de manipulation des images JPEG
chez





Intel, mais j'ai perdu la référence.




















Avatar
Christophe CAMPAIN
Michel,
l'adresse est refusée...

Kristof

"Michel Pierron" a écrit dans le message de
news:
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais péter
ton code

ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je
n'avais


plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne (ensemble
du


code + suggestion Michel dans Module UserForm ) et l'image apparait bien
redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN
perso


qui ramait suffisement pour voir que le résultat était pas mal... mais
pas


éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne parviens
pas à


déterminer (en mode débogage) le momment où et pourquoi le userform est
redéssiné (en fait je ne suis pas sur qu'il soit réellement redéssiné,
mais


en tout cas le userform apparaît vierge) éffacant ainsi le résultat de
l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et
continu


ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition que
la


fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage du
Userform (pas facile de décrire ça , quelques copies écran seraient les
bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça ressemble
à


du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis pas
un


expert en compression d'image, mais les fichiers obtenus sont super
light et


idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en 512
x


384

Par contre, j'ai toujours un problème de taille avec ce fichier excel
qui


semble emmagasiner toutes les photos chargées lors du traitement et ne
se


"Vide" les neurones qu'aprés une fermeture et réouverture complète du
fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que
j'ailles


alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As
Long



Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le
point



dans
Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN" a
écrit



dans le
message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à mes
besoins


(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples
d'utilisation




fournis sur le site
(http://www.alphabeta-net.com/VirtualPicture.html)




concernent l'utilisation dans un environnement VB et non VBA
d'office.




Je
ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire,
module,




autre...) ,si on doit créer un objet VirtualPicture sur un nouveau
formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me heurte à
l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une
erreur




et ne
me permet pas de tester le code veritablement. Lorsque je met les
lignes




de
code comportant Me en commentaire, tout le reste semble fonctionner
(l'éxécution ne génère pas d'erreur) mais je ne vois absolument rien
de




rien...

Si quelqu'un connait un peu le genre de problèmes que l'on rencontre
en




essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As Long
Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans le
message


de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image
"Light"






dans ses
documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait de
redimensionner une image et/ou de la convertir en JPEG ou en GIF,
je





ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres
formats





d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur
Telecharger.com






Il y avait bien une bibliothèque de manipulation des images JPEG
chez





Intel, mais j'ai perdu la référence.




















Avatar
Michel Pierron
Re Christophe;
Quel est ton message d'erreur ?
Cette adresse est fonctionnelle et accessible à d'autres (y compris les spameurs)
alors pourquoi pas toi ?
Elle fonctionne même quand je tombe dans l'oubli et que je m'écris pour me
remonter le moral !
Je te recommande d'insister.
MP

"Christophe CAMPAIN" a écrit dans le
message de news:
Michel,
l'adresse est refusée...

Kristof

"Michel Pierron" a écrit dans le message de
news:
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais péter
ton code

ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je
n'avais


plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne (ensemble
du


code + suggestion Michel dans Module UserForm ) et l'image apparait bien
redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN
perso


qui ramait suffisement pour voir que le résultat était pas mal... mais
pas


éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne parviens
pas à


déterminer (en mode débogage) le momment où et pourquoi le userform est
redéssiné (en fait je ne suis pas sur qu'il soit réellement redéssiné,
mais


en tout cas le userform apparaît vierge) éffacant ainsi le résultat de
l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et
continu


ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition que
la


fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage du
Userform (pas facile de décrire ça , quelques copies écran seraient les
bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça ressemble
à


du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis pas
un


expert en compression d'image, mais les fichiers obtenus sont super
light et


idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en 512
x


384

Par contre, j'ai toujours un problème de taille avec ce fichier excel
qui


semble emmagasiner toutes les photos chargées lors du traitement et ne
se


"Vide" les neurones qu'aprés une fermeture et réouverture complète du
fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que
j'ailles


alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As
Long



Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le
point



dans
Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN" a
écrit



dans le
message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à mes
besoins


(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples
d'utilisation




fournis sur le site
(http://www.alphabeta-net.com/VirtualPicture.html)




concernent l'utilisation dans un environnement VB et non VBA
d'office.




Je
ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire,
module,




autre...) ,si on doit créer un objet VirtualPicture sur un nouveau
formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me heurte à
l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une
erreur




et ne
me permet pas de tester le code veritablement. Lorsque je met les
lignes




de
code comportant Me en commentaire, tout le reste semble fonctionner
(l'éxécution ne génère pas d'erreur) mais je ne vois absolument rien
de




rien...

Si quelqu'un connait un peu le genre de problèmes que l'on rencontre
en




essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As Long
Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans le
message


de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image
"Light"






dans ses
documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait de
redimensionner une image et/ou de la convertir en JPEG ou en GIF,
je





ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres
formats





d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur
Telecharger.com






Il y avait bien une bibliothèque de manipulation des images JPEG
chez





Intel, mais j'ai perdu la référence.
























Avatar
Christophe CAMPAIN
Michel,
le message est le suivant :

"Impossible d'envoyer le message car l'un des destinataires a été refusé par
le serveur. L'adresse de messagerie refusée était ''.
Objet 'Redimensionnner images en VBA', Compte : 'pop.tiscali.fr', Serveur :
'smtp.tiscali.fr', Protocole : SMTP, Réponse du serveur : '550 RCPT
TO: Relaying not allowed', Port : 25, Sécurisé (SSL)
: Non, Erreur de serveur : 550, Numéro d'erreur : 0x800CCC79"

Kristof


"Michel Pierron" a écrit dans le message de
news:
Re Christophe;
Quel est ton message d'erreur ?
Cette adresse est fonctionnelle et accessible à d'autres (y compris les
spameurs)

alors pourquoi pas toi ?
Elle fonctionne même quand je tombe dans l'oubli et que je m'écris pour me
remonter le moral !
Je te recommande d'insister.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Michel,
l'adresse est refusée...

Kristof

"Michel Pierron" a écrit dans le message de
news:
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais
péter



ton code
ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a
écrit



dans le
message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je
n'avais


plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne
(ensemble




du
code + suggestion Michel dans Module UserForm ) et l'image apparait
bien




redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN
perso


qui ramait suffisement pour voir que le résultat était pas mal...
mais




pas
éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne
parviens




pas à
déterminer (en mode débogage) le momment où et pourquoi le userform
est




redéssiné (en fait je ne suis pas sur qu'il soit réellement
redéssiné,




mais
en tout cas le userform apparaît vierge) éffacant ainsi le résultat
de




l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et
continu


ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition
que




la
fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage
du




Userform (pas facile de décrire ça , quelques copies écran seraient
les




bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça
ressemble




à
du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis
pas




un
expert en compression d'image, mais les fichiers obtenus sont super
light et


idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en
512




x
384

Par contre, j'ai toujours un problème de taille avec ce fichier
excel




qui
semble emmagasiner toutes les photos chargées lors du traitement et
ne




se
"Vide" les neurones qu'aprés une fermeture et réouverture complète
du




fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que
j'ailles


alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long)
As





Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le
point



dans
Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN"
a





écrit
dans le
message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à
mes






besoins
(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples
d'utilisation




fournis sur le site
(http://www.alphabeta-net.com/VirtualPicture.html)




concernent l'utilisation dans un environnement VB et non VBA
d'office.




Je
ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire,
module,




autre...) ,si on doit créer un objet VirtualPicture sur un
nouveau






formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me
heurte à






l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une
erreur




et ne
me permet pas de tester le code veritablement. Lorsque je met
les






lignes
de
code comportant Me en commentaire, tout le reste semble
fonctionner






(l'éxécution ne génère pas d'erreur) mais je ne vois absolument
rien






de
rien...

Si quelqu'un connait un peu le genre de problèmes que l'on
rencontre






en
essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As
Long






Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans
le






message
de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image
"Light"






dans ses
documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait
de







redimensionner une image et/ou de la convertir en JPEG ou en
GIF,







je
ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres
formats





d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur
Telecharger.com






Il y avait bien une bibliothèque de manipulation des images
JPEG







chez
Intel, mais j'ai perdu la référence.




























Avatar
Christophe CAMPAIN
Salut Michel,

Je viens de réussir à t'envoyer les fichiers.

@+
Kristof


"Michel Pierron" a écrit dans le message de
news:
Re Christophe;
Quel est ton message d'erreur ?
Cette adresse est fonctionnelle et accessible à d'autres (y compris les
spameurs)

alors pourquoi pas toi ?
Elle fonctionne même quand je tombe dans l'oubli et que je m'écris pour me
remonter le moral !
Je te recommande d'insister.
MP

"Christophe CAMPAIN" a écrit
dans le

message de news:
Michel,
l'adresse est refusée...

Kristof

"Michel Pierron" a écrit dans le message de
news:
Bonjour Christophe;
Cela est probablement du à la chronologie de tes procédures. Fais
péter



ton code
ici pour qu'on te le dévermine ou bien en bal perso si tu préfères.
MP

"Christophe CAMPAIN" a
écrit



dans le
message de news:
Bonjour à tous,

Michel, Clément, désolé pour les confusions dans les noms mais je
n'avais


plus l'historique complet du post.
En tout cas merci à vous pour l'aide que vous m'apportez.

Du nouveau pour l'ActiveX : L'adaptation de Michel fonctionne
(ensemble




du
code + suggestion Michel dans Module UserForm ) et l'image apparait
bien




redimensionnée MAIS... (Il y a encore un mais...) Le tout disparait
quasiment instantanément... (J'ai pu le voir hier grace à ma TRABAN
perso


qui ramait suffisement pour voir que le résultat était pas mal...
mais




pas
éternel...)
--------
Je ne sais pas pourquoi l'affichage disparait aussitôt. Je ne
parviens




pas à
déterminer (en mode débogage) le momment où et pourquoi le userform
est




redéssiné (en fait je ne suis pas sur qu'il soit réellement
redéssiné,




mais
en tout cas le userform apparaît vierge) éffacant ainsi le résultat
de




l'activeX.
-------
Aprés quelques esais, si je met un point d'arrêt au début du code et
continu


ensuite sont éxécution (F5), le userform n'est pas "redessiné" et le
résultat de l'activeX est visible de manière constante (à condition
que




la
fenètre VBA soit réduite de façon à ne pas depasser sur l'affichage
du




Userform (pas facile de décrire ça , quelques copies écran seraient
les




bienvenues...).

En ce qui concerne la solution passant par un ChartObjects, ça
ressemble




à
du bricolage, mais j'ai été bluffé par les résultats !!! (Je ne suis
pas




un
expert en compression d'image, mais les fichiers obtenus sont super
light et


idéal pour un affichage écran (éviter de faire un zoom tout de même)
ex:
image origine : JPEG 227 Ko en 1024 x 768
Exportée par ChartObject : JPEG 36 Ko en 800 x 600 ; JPEG 15 Ko en
512




x
384

Par contre, j'ai toujours un problème de taille avec ce fichier
excel




qui
semble emmagasiner toutes les photos chargées lors du traitement et
ne




se
"Vide" les neurones qu'aprés une fermeture et réouverture complète
du




fichier (Problème de vidage de mémoire ?). Il faut d'ailleurs que
j'ailles


alimenter le post sur ce sujet...

Merci,

@+

Kristof





"Michel Pierron" a écrit dans le message de
news:%23$
Bonjour Christophe;
Dans ton module UserForm:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long)
As





Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private MehDC As Long

Private Sub UserForm_Activate()
MehDC = GetDC(GetActiveWindow)
End Sub

Execute ensuite les procédures de démo souhaitées en supprimant le
point



dans
Me.hDC
et reviens si tu as besoin de nouvelles infos.
MP

"Christophe CAMPAIN"
a





écrit
dans le
message de news:
Bonjour à tous,

Clément,

Je suis allé voir sur télécharger.com, et y ai trouvé un ActiveX
(gratuit)


nommé VirtualPicture.
L'executable Demo de cet ActiveX semble répondre parfaitement à
mes






besoins
(redimensionnement/compression image à la volée).

Cependant, cet ActiveX est développé en VB et les exemples
d'utilisation




fournis sur le site
(http://www.alphabeta-net.com/VirtualPicture.html)




concernent l'utilisation dans un environnement VB et non VBA
d'office.




Je
ne parviens pas à le tester avec VBA.

Il n'est pas précisé où le code doit être recopier (Formulaire,
module,




autre...) ,si on doit créer un objet VirtualPicture sur un
nouveau






formulaire, comment les nommer etc.

Ce qui fait qu'en essayant de tester le code suivant, je me
heurte à






l'instruction "objPicture.PaintPicture Me.hDC" où Me génère une
erreur




et ne
me permet pas de tester le code veritablement. Lorsque je met
les






lignes
de
code comportant Me en commentaire, tout le reste semble
fonctionner






(l'éxécution ne génère pas d'erreur) mais je ne vois absolument
rien






de
rien...

Si quelqu'un connait un peu le genre de problèmes que l'on
rencontre






en
essayant d'adapter un code VB pour le VBA, ses conseils sont les
bienvenus.



@+
Kristof

'---------------------
Dim objPicture As VirtualPicture.IPicture2
Dim objSample As VirtualPicture.IPicture2
Dim lngNewHeight As Long, lngNewWidth As Long, lngCurrX As
Long






Dim lngCurrentY As Long
Dim obj As Object

'-- Création d'un objet IPicture
Set obj = CreateObject("VirtualPicture.Picture")
Set objPicture = obj
Set obj = Nothing
'------------------------------


'-- Rectangles, lignes, Pixels
If objPicture.Create(120, 120) Then
' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)
Call objPicture.LineTo(0, 0, 119, 119, vbRed)
Call objPicture.Rectangle(1, 50, 10, 119, vbGreen)
Call objPicture.Rectangle(10, 25, 20, 119, vbBlue)
Call objPicture.SetPixel(119, 0, vbGreen)

objPicture.PaintPicture Me.hDC
End If

'-- Affichage aléatoire N/B
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits True

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 130, 0
End If

'-- Affichage aléatoire Couleurs
If objPicture.Create(120, 120) Then
objPicture.RandomiseBits

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

objPicture.PaintPicture Me.hDC, 260, 0
End If

' Editer un Texte
If objPicture.Create(120, 120) Then

' Cadre
Call objPicture.LineTo(0, 0, 119, 0, vbBlack)
Call objPicture.LineTo(119, 0, 119, 119, vbBlack)
Call objPicture.LineTo(119, 119, 0, 119, vbBlack)
Call objPicture.LineTo(0, 119, 0, 0, vbBlack)

With objPicture.Font
.Name = "Verdana"
.Size = 10
.Color = vbRed
End Withw
objPicture.PrintText "Test", 1, 1
lngCurrentY = objPicture.TextHeight("Test")

objPicture.Font.Color = vbBlack
objPicture.Font.Bold = True
objPicture.PrintText "Font Verdana", 10, lngCurrentY
lngCurrentY = lngCurrentY + objPicture.TextHeight("Font
Verdana")



objPicture.PrintText "Size 10", 20, lngCurrentY

objPicture.PaintPicture Me.hDC, 390, 0
End If

' Chargement d'une image JPEG et redimensionnement
If objPicture.LoadJPG(App.Path & "Tyra4.jpg") Then
lngNewHeight = 200
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, 0, 130
Set objSample = Nothing

lngNewHeight = 400
lngCurrX = lngNewWidth
lngNewWidth = lngNewHeight * 0.844
Set objSample = objPicture.Resample(lngNewHeight,
lngNewWidth)




objSample.PaintPicture Me.hDC, lngCurrX + 10, 130

Set objSample = Nothing
End If

' Libération des ressources
Set objPicture = Nothing
'------------------------------

"Clément Marcotte" a écrit dans
le






message
de news:%
Bonjour,

Ce que je cherche c'est une
façon transparente pour l'utilisateur d'inclure une image
"Light"






dans ses
documents (Par n'importe quel moyen)


À part que de te trouver un contrôle ActiveX qui permettrait
de







redimensionner une image et/ou de la convertir en JPEG ou en
GIF,







je
ne vois pas trop.

Les contrôles Image et PictureBox de MS peuvent lire d'autres
formats





d'image que BMP, mais exportent seulement en BMP.

Pour des contrôles ActiveX, tu peux jeter un oeil sur
Telecharger.com






Il y avait bien une bibliothèque de manipulation des images
JPEG







chez
Intel, mais j'ai perdu la référence.




























1 2