XL 2019 Images disparaissent après suppression source/lien

Samtchevsky · 1 Mai 2020

Bonjour,

Je n'ai malheureusement pas trouvé de réponse à ma problématique sur les différents forums!
Sur un fichier je fais de l'intégration de photos (en masse) d'un fichier source dans mon Excel avec la macro ci-dessous:

VB:

Sub AffImage()
    Const hDefaut = 200

    Dim msg As String, r As Long, h As Long
    Dim C As Range, numfich As Integer
    Dim fich
    r = 1
    h = 200
    For Each C In Selection 'c.ColumnWidth = 10
        fich = C.Value
        If fich <> "" Then
        C.RowHeight = h
   ActiveSheet.Pictures.Insert(fich).Select
            With Selection.ShapeRange
    .Name = "Photo"
    .LockAspectRatio = msoTrue
    .Height = [D14:H14].Height + 115
    .Left = [D14:H14].Left + 100
    .Top = [D14:H14].Top - 343
                End With
        End If
    Next C
End Sub

La problématique est que lorsque je supprime le dossier source comprenant les-dîtes photos, les photos disparaissent du fichier Excel.
Je n'arrive pas à trouver comment "fixer" ces photos au fichier.

Merci de votre aide.

sousou · 1 Mai 2020

Etrange,
J'ai testé ton code pas de problème, j'ai simplement précisé le chemin de ton fichier.
Tout dépend de la forme de ta feuille (c.value?)

Samtchevsky · 1 Mai 2020

sousou à dit:
Etrange,
J'ai testé ton code pas de problème, j'ai simplement précisé le chemin de ton fichier.
Tout dépend de la forme de ta feuille (c.value?)

Comment ça pas de problème?
Lorsque tu modifies/supprimes le nom du dossier source la photo reste présente sur ton fichier Excel?

Je gère la construction du lien comme suit:
1. Le lien du fichier est inscrit dans une cellule de la Feuill3 ou va être collée l'image: ='Feuill1'!$E$4&$F$9&".jpg"
2. Lien du dossier est collé dans la cellule E4 de la Feuill1: C:\Users\morga\Desktop\Photos Fiche Equipement

J'utilise cette construction car la macro "Affimage" fait partie d'une macro plus complexe qui me permet de créer un onglet par photo.

patricktoulon · 1 Mai 2020

bonjour
ben ca dépends si tu relance la sub x fois pour des éventuelles mises a jours c'est normal
d'autant plus quelles portent le même nom
d'autant plus que pendant la boucle tu select l'image a chaque tours
donc dans ta boucles il y a peut etre un conflit de type d'object
et en plus tu les placent toujours au même endroit l'une sur l'autre

VB:

Sub AffImage()
    Const hDefaut = 200

    Dim msg As String, r As Long, h As Long
    Dim C As Range, numfich As Integer
    Dim fich, img
    r = 1
    h = 200
    For Each C In Selection    'c.ColumnWidth = 10
        fich = C.Value
        If fich <> "" Then
            C.RowHeight = h
            If Dir(fich) <> "" Then
               Set img = ActiveSheet.Pictures.Insert(fich)
                With img.ShapeRange
                    .Name = "Photo" & C.Address(0, 0)
                    .LockAspectRatio = msoTrue
                    .Height = [D14:H14].Height + 115'????????????
                    .Left = [D14:H14].Left + 100'????????????
                    .Top = [D14:H14].Top - 343'????????????
                End With
            End If
        End If
    Next C
End Sub

Samtchevsky · 1 Mai 2020

J'ai refais le fichier plus simplement pour l'alléger pour que vous compreniez le besoin et ayez l'ensemble de la macro!

1. Il vous suffit de reprendre le lien du dossier source "Test" comprenant les 3 photos sur l'onglet "Equipement" en B2.

2. En appuyant sur le bouton "Créer fiche équipement" les fiches vont se créer un intégrant les photos.

Problématique: Lors que je supprime/renomme/déplace le dossier source l'image disparaît. Je souhaiterais vraiment la fixer au fichier Excel.
@patricktoulon Je lance la macro qu'une seule fois pour générer les fiches et après bloque le fichier Excel en lecture. Si je dois regénérer les fiches je repars de la base vierge.

PS: Je n'ai pas corrigé le positionnement de l'image car cela ne change pas le sens de ma demande à mon avis!

Merci pour vos retours.

sousou · 1 Mai 2020

Je ne trouve pas vraiment,
Je vais tenter de refaire le fichier, je pense qu'il as des soucis avec tes liens vers d'autres fichiers.
D'autre part je ne saisie pas trop bien la forme de ton code.A quoi sert ta boucle sur la cellule c9

Samtchevsky · 1 Mai 2020

sousou à dit:
Je ne trouve pas vraiment,
Je vais tenter de refaire le fichier, je pense qu'il as des soucis avec tes liens vers d'autres fichiers.
D'autre part je ne saisie pas trop bien la forme de ton code.A quoi sert ta boucle sur la cellule c9

En toute transparence, cela vient de plein de macro que j'ai adapté avec mes "connaissances" pour coller à ce que je veux! Pour le coût à part ce souci de "fixer" l'image le reste fonctionne bien haha
1. Je ne vois pas de quoi tu parles sur les liens vers d'autres fichiers? Les seuls liens sont entre deux onglets et un dossier contenant les photos pour moi.
2. Concernant la boucle sur C9, tu parles de ce morceau de code?

VB:

FL1.Hyperlinks.Add FL1.Cells(NoLig, 1), "", "'" & NoLimitcar & "'!C9"

Si oui, il me sert à créer un lien hypertexte de la première colonne à l'onglet qui est créé. Sur 3 onglets pas d'intérêt mais sur 150!

sousou · 2 Mai 2020

Quelle version d'excel?

Samtchevsky · 2 Mai 2020

sousou à dit:
Quelle version d'excel?

Microsoft Office 365

MJ13 · 2 Mai 2020

Bonjour à tous

"Problématique: Lors que je supprime/renomme/déplace le dossier source l'image disparaît. Je souhaiterais vraiment la fixer au fichier Excel."

Quand je lis ce problème, c'est tout à fait logique, Excel ne peut pas résoudre facilement le déplacement de dossiers d'images quand on a des liens sur une feuille Excel.

Il faut toujours que le fichier Excel soit dans le dossier contenant les images, soit trouver un moyen pour changer le lien des images, mais cela peut-être plus complexe. Perso, j'ai jamais essayé, si quelqu'un le fait, ça m'intéresse.

Une autre solution serait de copier l'image sur la feuille en jpg pour s'affranchir de ce problème, mais attention à la taille du fichier si on en a beaucoup.

Tu peux aussi changer le lien avec une macro de ce type à adapter:

VB:

Selection.Hyperlinks(1).Address = "C:\Users\Utilisateur\Desktop\Test\Test\" & ActiveCell & ".jpg"

sousou · 2 Mai 2020

Bon!!
Après de longs essais,
En 2010 pas de problème insert fonctionne sans gérer le lien avec l'image . Pourquoi??
mais pour régler ton soucis regarde ce fichier, différence entre pictures.insert et shapes.addpicture

Samtchevsky · 2 Mai 2020

MJ13 à dit:
Bonjour à tous

"Problématique: Lors que je supprime/renomme/déplace le dossier source l'image disparaît. Je souhaiterais vraiment la fixer au fichier Excel."

Quand je lis ce problème, c'est tout à fait logique, Excel ne peut pas résoudre facilement le déplacement de dossiers d'images quand on a des liens sur une feuille Excel.

Il faut toujours que le fichier Excel soit dans le dossier contenant les images, soit trouver un moyen pour changer le lien des images, mais cela peut-être plus complexe. Perso, j'ai jamais essayé, si quelqu'un le fait, ça m'intéresse.

Une autre solution serait de copier l'image sur la feuille en jpg pour s'affranchir de ce problème, mais attention à la taille du fichier si on en a beaucoup.

Tu peux aussi changer le lien avec une macro de ce type à adapter:

VB:

Selection.Hyperlinks(1).Address = "C:\Users\Utilisateur\Desktop\Test\Test\" & ActiveCell & ".jpg"

Bonjour MJ13,

Je te remercie pour ton message, j'ai bien conscience que le fichier Excel sera très lourd si je "colle" l'image directement dans le fichier Excel. Mais en tout cas la solution m'intéresserait pour ma connaissance personnelle^^

Est-il possible alors de faire une macro qui serait dynamique jusqu'au dossier source qui comprendrait alors le fichier Excel + le dossier photos?

Samtchevsky · 2 Mai 2020

sousou à dit:
Bon!!
Après de longs essais,
En 2010 pas de problème insert fonctionne sans gérer le lien avec l'image . Pourquoi??
mais pour régler ton soucis regarde ce fichier, différence entre pictures.insert et shapes.addpicture

Bonjour SOUSOU,

Du coup avec ta méthode mon code complet pourrait se résumer à ça:

VB:

Sub CommandButton1_Click()

 Dim FL1 As Worksheet, NoCol As Integer
        Dim NoLig As Long, Var As Variant, NoSupslash As String, NoLimitcar As String, NoTitle As String, NoSupslashspace As String
            Set FL1 = Worksheets("Equipement")
            NoCol = 6
            For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
                Var = FL1.Cells(NoLig, NoCol)
                If Var = "Oui" Then
                Worksheets("Fiche équipement type").Copy After:=Worksheets(Worksheets.Count)
                    NoTiltle = FL1.Cells(NoLig, 1).Text
                    NoSupslash = Replace(NoTiltle, "/", "-")
                    NoLimitcar = Mid(NoSupslash, 1, 31)
                    Worksheets(Worksheets.Count).Name = NoLimitcar
                    Worksheets(Worksheets.Count).Range("F4") = FL1.Cells(NoLig, 1)
                    FL1.Hyperlinks.Add FL1.Cells(NoLig, 1), "", "'" & NoLimitcar & "'!C9"
                    Set im = ActiveSheet.Shapes.AddPicture(ActiveSheet.Range("C9"), False, True, 500, 150, 200, 200) 'Lien photo, Lien vers dossier, Enregistrement sur fichier, Left, Top, Width, Height
               End If
            Next
            Set FL1 = Nothing
End Sub

Je ne fais plus appel à la ligne "Call Affimage" et utilise ta ligne " Set im = ActiveSheet.Shapes.AddPicture(ActiveSheet.Range("C9"), False, True, 500, 150, 200, 200)"
J'ai modifié le lien de la photo pour le rendre dynamique et j'ai fais l'essai en déplaçant le dossier source et les images ne disparaissent pas du fichier Excel donc ça à l'air bon^^

Je vais le tester sur le fichier principal et mettrais la discussion en résolu si cela est ok^^

@MJ13, par contre l'idée du lien dynamique jusqu'au dossier source comprenant le fichier + le dossier photo m'intéresse beaucoup^^

MJ13 · 2 Mai 2020

Re

Ce lien te montre comment Excel travaille par rapport aux paramètres de addpicture, c'est ce qu'il y a de plus simple pour comprendre.

Méthode Shapes.AddPicture (Excel)

Rubrique de référence sur Office VBA

docs.microsoft.com

Pour copier l'image en dur, c'est assez simple, tu utilises l'enregistreur de macros, tu copies une image en collage spécial jpg, png ou gif pour voir celui qui te convient puis tu récupères le code et tu l'adaptes aux images présentes sur ta feuille.

Autre chose importante, quand tu sauvegardes ton fichier, il y a dans Outils, options un paramètre pour enregistrer en compressant plus ou moins les images.

sousou · 2 Mai 2020

Ton code pourrait se résumé à celà,j'ai simplement changée une ligne.
Mais il pourrait être plus simple .... à suivre....

XL 2019 Images disparaissent après suppression source/lien

Samtchevsky

XLDnaute Nouveau

sousou

XLDnaute Barbatruc

Samtchevsky

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Samtchevsky

XLDnaute Nouveau

Pièces jointes

sousou

XLDnaute Barbatruc

Samtchevsky

XLDnaute Nouveau

sousou

XLDnaute Barbatruc

Samtchevsky

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

sousou

XLDnaute Barbatruc

Pièces jointes

Samtchevsky

XLDnaute Nouveau

Samtchevsky

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

Méthode Shapes.AddPicture (Excel)

Pièces jointes

sousou

XLDnaute Barbatruc

Pièces jointes

Discussions similaires