Ingevoegde afbeelding verdwijnt na verwijderen van afbeeldingsbestand

[ADvH]

Goedemorgen,

Met onderstaande code voeg ik een afbeelding uit een extern afbeeldingsbestand in. Werkt perfect, als ik echter het afbeeldingsbestandje (laten we zeggen afbeelding.jpg) weggooi en ik start de excelsheet opnieuw dan is de afbeelding verdwenen en staat er de melding dat de afbeelding verwijdert of verplaatst is. Is er code om de afbeelding in te sluiten in het excelbestand?

Sub test()
    FileToOpen = Application.GetOpenFilename("JPEG-Afbeelding (*.jpg), *.jpg")
        If FileToOpen = False Then Exit Sub
    Range("Actueel!B5000").End(xlUp).Offset(-9, 3).Select
    ActiveSheet.Pictures.Insert(FileToOpen).Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = Application.CentimetersToPoints(6.3)
    Selection.ShapeRange.Width = Application.CentimetersToPoints(4.2)
End Sub

Alvast bedankt voor het meedenken,

Gr Albert

 

[OctaFish]

Ik kan het niet reproduceren, bij mij blijft de afbeelding gewoon staan als ik hem van naam verander, verplaats of verwijder.

 

[ADvH]

Beste Actafish,

Dank voor je reactie. Ik ging even twijfelen en heb op mijn werk de code in een excel geplakt en uitgevoerd, plaatje blijft staan zolang het afbeeldingsbestand blijft bestaan én op dezeflde plaats blijft steen én niet van naam verandert. Gooi ik het bestand je weg, dan zie ik onderstaande :


Zou het een instelling van Excel zelf kunnen zijn? Heb ik ook al naar gezocht, maar niets kunnen vinden.

Vr Gr Albert

 

[OctaFish]

Ik kan er ook niets over vinden. Wellicht dat iemand anders de oorzaak weet.

 

[snb]

Met deze methode kun je aangeven of de afbeelding als link of als bestand moet worden ingevoegd, en of de afbeeling in het Excel bestand moet worden opgeslagen.
Ik vind jouw code minder voor-de-hand-liggend.
Als het goed is, heeft verwijdering/wijziging van het oorspronkelijke afbeeldingsbestand dan geen invloed op de afbeelding in het Excelbestand.

Sub M_snb()
    Sheet1.Shapes.AddPicture("G:\OF\peer.jpg", 0, 1, 10, 10, 100, 100).Placement = 3
End Sub

 

[ADvH]

Heren,

Beide dank voor het meedenken. de oplossing werkt!

@snb: waarom ik voor de 'ActiveSheet.Pictures.Insert' gekozen heb is omdat die invoegt vanaf de cel die geselecteerd is. Met jouw oplossing kom ik tot onderstaande om hetzelfde te bereiken(er vanuitgaande dat alle rijhoogtes 15,00 zijn)

is dit logisch of is daar ook beter methode voor:

Sub test2()
    FileToOpen = Application.GetOpenFilename("JPEG-Afbeelding (*.jpg), *.jpg")
        If FileToOpen = False Then Exit Sub
    RIJ = Range("Actueel!B5000").End(xlUp).Offset(-9, 3).Row
    ActiveSheet.Shapes.rangeAddPicture(FileToOpen, 0, 1, 10, (15 * RIJ), 100, 100).Placement = 3
    
End Sub

Groet Albert

 

[snb]

Ik denk niet dat je die code getest hebt ...

Sub M_snb()
  With Application.FileDialog(3)
    .InitialFileName = "G:\OF\*.jpg"
    If .Show Then ActiveSheet.Shapes.AddPicture(.SelectedItems(1), 0, 1, ActiveCell.Top, ActiveCell.Left, 100, 100).Placement = 3
  End With
End Sub

 

[ADvH]

Goedemorgen snb,

Het werkt wel, alleen moet je dan geen typefout maken: "ActiveSheet.Shapes.rangeAddPicture(FileToOpen, 0, 1, 10, (15 * RIJ), 100, 100).Placement = 3", het woordje range moet er van tussen.

Jouw code is helemaal super en ga ik gebruiken!! (zit overigens ook een typefoutje in:d, activecell.left en activecell.top moet omgewisseld worden...)

Hartelijk dank Albert
(geweldig dit forum!!)