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 ?