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
 

gourdin

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

Merci beaucoup

Celà semble fonctionner après un premier essai.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas