XL 2019 Images disparaissent après suppression source/lien

[Samtchevsky]

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:

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]

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]

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]

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

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]

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]

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]

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?

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]

Quelle version d'excel?

 

[Samtchevsky]

Quelle version d'excel?

Microsoft Office 365

 

[MJ13]

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:

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

 

[sousou]

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]

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:

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]

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:

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]

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]

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