Insertion image - Macro imposée taille maxi

gourdin

XLDnaute Impliqué
Bonjour,

Ci-dessous une macro permettant l'insertion d'image qui fonctionne très bien.
Est il possible de limiter la taille de l'image par la macro ?
Exemple si l'image choisie dépasse 300 Ko la macro envoie un message en signalant que la taille est trop grande et que l'insertion n'est pas possible.

Merci.

Code Macro :
Code:
Sub Inserer_image()
Dim Choix
With ActiveSheet
    Choix = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
    , , "Choix de l'image", , False)
    If Choix = False Then Exit Sub
    On Error Resume Next
    .Pictures.Insert(Choix).Name = "NewPhoto"
End With
End Sub
 

tototiti2008

XLDnaute Barbatruc
Re : Insertion image - Macro imposée taille maxi

Bonjour gourdin,

un essai

Code:
Sub Inserer_image()
Dim Choix, fs, f
With ActiveSheet
    Choix = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
    , , "Choix de l'image", , False)
    If Choix = False Then Exit Sub
    On Error Resume Next
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfile(Choix)
    If f.Size > 307200 Then
        MsgBox "Taille d'image trop importante" & Chr(10) & "Choisissez une image de moins de 300 Ko"
        Exit Sub
    End If
    Set f = Nothing
    Set fs = Nothing
    .Pictures.Insert(Choix).Name = "NewPhoto"
End With
End Sub
 

Discussions similaires

Réponses
39
Affichages
4 K