Macro insertion image automatiquement.

MJ13

XLDnaute Barbatruc

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

Ok mais ça se n'est pas mon problème, je voudrai une macro avec insertion auto et qu'elle puisse stocker mes images dans le fichiers Excel.
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

Alors QUESTION:

Es posssible de créer une macro pour faire des insertions image en automatique et que les images soient stockés sur mon fichier Excel peux un porte la taille de mon fichier Excel même si il fait plus 300 Mo?

Merci d'avance.
 

MJ13

XLDnaute Barbatruc
Re : Macro insertion image automatiquement.

Réponse:

Oui :(.

Voir ici par exmple, sinon, G....e est ton ami :).

FAQ MS-Excel
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : Macro insertion image automatiquement.

Re

Bon, comme cela m'intéressait, voici un code sympa que j'ai pu faire grâce aux codes de MichelXLD :).

Code:
Sub AjoutImageFeuille_V02_PlusRespectTaille()
'MJ issu du travail de MichelXLD
    Dim Shp As Shape, Fichier As String, iPict As IPictureDisp
    n = 2
    For Each cell In Selection
        Fichier = cell    'Cells(1, 1)
        'Fichier = "C:\Documents and Settings\mimi\dossier\Image2.jpg"
        'expression.AddPicture(FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
        'Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 0, 0, 100, 90)
        'ActiveSheet.Pictures.Insert Fichier
        Set iPict = LoadPicture(Fichier): Larg = Round((iPict.Width) / 23.96, 0): Haut = Round((iPict.Height) / 23.96, 0)
        If Larg >= Haut Then Set Shp = ActiveSheet.Shapes.AddPicture(Fichier, msoTrue, msoCTrue, 5, 5, 400, (Haut * 400) / Larg)
        If Haut > Larg Then Set Shp = ActiveSheet.Shapes.AddPicture(Fichier, msoTrue, msoCTrue, 5, 5, (Larg * 400) / Haut, 400)
        'Shp.Select: Shp.Cut: Sheets("Feuil2").Select: Cells(n, 1).Select: ActiveSheet.Paste: n = n + 1: Sheets("Feuil1").Select
        Shp.Select: Shp.Cut: Sheets("Feuil2").Select: Cells(n, 1).Select
        ActiveSheet.PasteSpecial Format:="Image (JPEG)", Link:=False, _
         DisplayAsIcon:=False: n = n + 1
        Sheets("Feuil1").Select
        Set iPict = Nothing
    Next
End Sub
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

Salut MJ13,

Merci pour ta recherche je vais tester ça.
La macro que tu a fait est bien pour les images en colonne A et pour le nom de l'image en colonne B ?

Cordialement Kinkin
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

Bon j'ai testé ça marche pas les photos viennent en gros et après elle disparait or elle sont en 60X60 donc de petite taille.
ta pas le code vba pour stocker les photos sur le fichier excel seulement.
Pq moi mon code suivant :
Sub Macro1()

On Error Resume Next
For Each o In Selection
o.Activate
Z = o_Offset(0, 1) & ".jpg"
ActiveSheet.Pictures.Insert ("C:\PHOTOS_BASE_DE_DONNEE\" & Z)
Next
End Sub

M'inséres les photos à partir des références sur la colonne B et me mets les photos sur la colonne A mais il ne les stock pas dans le fichier Excel.
 

MJ13

XLDnaute Barbatruc
Re : Macro insertion image automatiquement.

Re

Maintenant, tu dois adapter le code à ta problèmatique.

Sinon, envoie ton fichier avec 2 ou 3 images pour faire le test pour éviter de tourner en rond :).
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

Franchement tu es un vrai pro merci ça fonctionne.
Parcontre c'est pas possible de me retirer la case pour appliquer la macro si c'est pas trop demander.

Merci d'avance.
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

C'est bon j'ai trouvé tout seul et encore MERCI à toi et MichelXLD.

Cordialement Kinkin.
 

TempusFugit

XLDnaute Impliqué
Re : Macro insertion image automatiquement.

Bonjour

Par curioisté, quelle est la taille de ton fichier final avec les images ?

Il n'est pas trop gros pour être envoyé par email ?
 

MJ13

XLDnaute Barbatruc
Re : Macro insertion image automatiquement.

Re

Parcontre c'est pas possible de me retirer la case pour appliquer la macro si c'est pas trop demander.
Click droit sur le bouton et couper.

Attention: j'ai définit les noms des images à intégrer avec un nom (zone).

Pour l'éviter tu peux mettre un commentaire (') sur le code

Code:
'Application.Goto Reference:="zone"
et sélectionner ta liste de noms avant de lancer la macro avec Alt+F8.
 

kinkin77

XLDnaute Nouveau
Re : Macro insertion image automatiquement.

C'est tout good j'ai trouver le problème, j'ai du ajouter une commande si il ne trouve pas l'image. et maintenant tout es ok youpi encore merci.
@TempusFugit: mon fichier final fait 8.7Mo avec plus de 2500 images.

Merci et encore bravo à toute l'équipe ;)
 

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