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

liwi · 30 Novembre 2020

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 · 6 Décembre 2020

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 · 7 Décembre 2020

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 · 7 Décembre 2020

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

VB:

    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

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

liwi

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

liwi

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Discussions similaires