Macro insertion image automatiquement.

kinkin77

XLDnaute Nouveau
Bonjour,

J'ai créé un fichier Excel pour référencer mes films
J'ai un fichier Excel avec la colonne A pour les photos et une colonne B avec des références.
J'ai réussi à faire une macro pour insérer mes photos automatiquement via la référence de la colonne B. voir ci-dessous:

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

Mon problème est dès que j'envoie mon fichier à un amis les photos ne s'affiche pas.
Auriez-vous la solution à mon problème.
Cordialement.
 

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.

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.

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.
 

Discussions similaires

Réponses
10
Affichages
482