Discussion :

[Dom91]

Bonjour à tous,

J'importe une photo de la première page d'un document .pdf ou .ppt que j'insère dans un Userform pour vérifier qu'il s'agit bien du document voulu.
Si c'est bien le bon document, je veux sauvegarder cette image dans un fichier .bmp mais en diminuant son poids pour des valeurs de 100 x 12O dpi.
Le code ShapeRange.height diminue visuellement la dimension mais conserve les dimensions initiales lors de l'enregistrement.

Ma macro est la suivante :

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
Dim lPicType As Long
 
MaVar = Range("Chemin").Value & Client & "\Presentation"
ChDir MaVar
fileToOpen = Application.GetOpenFilename("Documents (*.ppt;*.pps;*.doc;*.pdf;*.mpg), *.pdf", , "Sélectionnez un fichier")
If fileToOpen <> False Then
    UserForm1.Label47 = fileToOpen
    ActiveSheet.OLEObjects.Add(Filename:=fileToOpen, link:=False, DisplayAsIcon:=False).Select
    With Selection
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.height = 120
        .CopyPicture xlScreen, xlBitmap
    End With
    Set Frame6.Photo.Picture = PastePicture(lPicType)
Else: Exit Sub
End If
MaVar = Range("Chemin").Value & Client & "\Photos\Icones"
ChDir MaVar
SavePicture UserForm1.Frame6.Photo.Picture, MaVar & ".bmp"
End Sub

Est ce que quelqu'un a une idée ?

[SilkyRoad]

bonjour


Tu pourrais par exemple utiliser la librairie "Windows Image Acquisition":

http://silkyroad.developpez.com/VBA/...geAcquisition/



ps
il est d'usage de cloturer les anciens sujets avant d'en ouvrir de nouveaux:

http://www.developpez.net/forums/sho...d.php?t=420029



bonne soirée
michel

[Dom91]

Merci pour ta réponse.
En fait, je crée une image OLE que je transforme en image Bitmap grâce à la méthode PastePicture de Stephen Bullen.
J'ai pensé à 3 solutions pour comprimer l'image

1°) Utiliser la fonction Shaperange mais je n'ai pas trouvé l'attribut de compression

2°) Ajouter un format API à la méthode PastePicture que définit déjà les paramètres suivants :

Code :

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

1
2
3
4
5
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4

Quel est alors le nouveau format API à ajouter ?

3°) Utiliser la librairie Windows Image Application mais il me faut revoir compètement ma macro alors que dans les 2 solutions ci-dessus, il suffit d'insérer une ligne de commande