XL 2013 "Impossible d'afficher l'image liée...."

[liwi]

Bonjour,
lorsque je partage mon excel, mon correspondant n'a plus les photos insérées via la macro ci-dessous. j'ai parcouru le forum. il y a beaucoup d'information et des formules diverses pour "figer" ces photos afin qu'elles ne disparaissent pas lorsque qu'elles ne sont plus sur mon pc
par avance merci pour votre aide.
Dim ficimg As Variant
'ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")
Dim i As Integer, j As Integer, col As Integer, k As Integer
Dim rg As Range
j = 1
With Selection
'Debug.Print .Rows.Count
'.Columns(5).ColumnWidth = Range("Largeur")
For i = 1 To .Rows.Count
If .Cells(i, Range("COL_LIEU")).Value <> "" Then
'Cells(.Rows(i), .Columns(6)).Select
.Rows(j).RowHeight = Range("Hauteur")
For k = 1 To 2
ficimg = .Cells(i, Range("COL_PHOTO" & k)).Value
'Debug.Print ficimg
If UCase(Right(ficimg, 3)) = "JPG" Then
.Cells(j, Range("ColPhoto" & k)).Select
ActiveSheet.Pictures.Insert(ficimg).Select
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Top = ActiveCell.Top + 4
Selection.ShapeRange.Left = ActiveCell.Left + 4
Selection.ShapeRange.Height = ActiveCell.RowHeight - 8
Selection.PrintObject = True
Selection.Placement = xlMoveAndSize
End If

 

[fanch55]

Bonsoir,

Si vous insérez une picture (méthode Insert), elle reste liée au fichier image que vous avez choisi.
Si ce fichier était sur un disque local ( le vôtre ) , il ne sera plus disponible sur un autre pc .
Si ce fichier était sur un disque réseau, il sera disponible pour tout Pc ayant accès à celui-ci .

Si vous voulez vous affranchir de cette spécificité, il faut prendre la methode Picture.add en précisant qu'il n'y pas de lien .

En ce cas, l'image est "Embedded", c'est à dire incorporée à votre classeur et fera augmenter la taille de celui-ci .

C'est un choix ...

 

[liwi]

Bonjour,
je vous remercie pour cette information. j'ai remplacé insert par Add dans ma macro dans la ligne
"ActiveSheet.Pictures.Insert(ficimg).Select"par "ActiveSheet.Pictures.Add(ficimg).Select".
Malheureusement ca ne fonctionne pas. La macro bug au moment de mettre les photos. j'ai remis la formule initiale avec insert et ca fonctionne donc je n'ai pas mis la bonne ligne de commande.
ci dessous la macro complète
merci par avance pour votre aide bonne journée
Dim ficimg As Variant
'ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")
Dim i As Integer, j As Integer, col As Integer, k As Integer
Dim rg As Range
j = 1
With Selection
'Debug.Print .Rows.Count
'.Columns(5).ColumnWidth = Range("Largeur")
For i = 1 To .Rows.Count
If .Cells(i, Range("COL_LIEU")).Value <> "" Then
'Cells(.Rows(i), .Columns(6)).Select
.Rows(j).RowHeight = Range("Hauteur")
For k = 1 To 2
ficimg = .Cells(i, Range("COL_PHOTO" & k)).Value
'Debug.Print ficimg
If UCase(Right(ficimg, 3)) = "JPG" Then
.Cells(j, Range("ColPhoto" & k)).Select
ActiveSheet.Pictures.Insert(ficimg).Select
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Top = ActiveCell.Top + 4
Selection.ShapeRange.Left = ActiveCell.Left + 4
Selection.ShapeRange.Height = ActiveCell.RowHeight - 8
Selection.PrintObject = True
Selection.Placement = xlMoveAndSize
End If

 

[fanch55]

Pardon, répondu trop rapidement, ce n'est pas pictures.Add mais shapes.addpicture

    ficimg = "D:\Users\......jpg"
    Nom_Image = "Toto"
    On Error Resume Next
       ' On détruit l'image si la feuille en contient une du même nom
       ' Très important car sinon les images s'entassent les unes sur les autres
        ActiveSheet.Shapes(Nom_Image).Delete
    On Error GoTo 0
    With ActiveSheet.Shapes.AddPicture( _
        ficimg, msoFalse, msoTrue, _
        ActiveCell.Left + 4, ActiveCell.Top + 4, _
        ActiveCell.Width - 8, ActiveCell.RowHeight - 8)
        .Name = Nom_Image
        .ControlFormat.PrintObject = msoTrue
        .LockAspectRatio = msoTrue
        .Placement = xlMoveAndSize
    End With