Bağlantılı resim görüntülenemiyor, Dosya taşımış hatası

[mydestek]

Merhaba Arkadaşlar,

Eklediğim excel örneğinde derdimi atlatmaya çalıştım.
Excel resim linkleri çalışıyor, fakat resimler üzerinde "Bağlantılı resim görüntülenemiyor, Dosya taşımış hatası.. " var, resimler excel de görünmüyor.
Toplu olarak nasıl düzeltirim.

Resim ekleme kodum;

Sub xresimyukle()
    Dim xresimsec As String
    Dim resimyol As String
    Dim Adres As Range
    Set Adres = Selection
    xresimsec = Application.GetOpenFilename()
    On Error Resume Next
    Set Pic = ActiveSheet.Pictures.Insert(xresimsec)
    With Pic
     .ShapeRange.LockAspectRatio = msoFalse
     .Height = (Adres.Height - 8)
     .Width = (Adres.Width - 8)
     .Top = (Adres.Top + 4)
     .Left = (Adres.Left + 4)
     .Placement = (xlMoveAndSize)
      End With
      resimyol = Replace(xresimsec, "\kucuk\", "\")
      ActiveSheet.Hyperlinks.Add Anchor:=Pic.ShapeRange.Item(1), Address:=resimyol
 
End Sub

 

[mydestek]

Fikri olan var mı?

 

[Haluk]

Merhaba,

Ne yapmak istediğiniz tam anlamadım ........ Koddaki aşağıdaki satırı neden kullanıyorsunuz ? O satır olmasa da resim Excel'e gelir.

resimyol = Replace(xresimsec, "\kucuk\", "\")

.

 

[mydestek]

Merhaba,

Ne yapmak istediğiniz tam anlamadım ........ Koddaki aşağıdaki satırı neden kullanıyorsunuz ? O satır olmasa da resim Excel'e gelir.

resimyol = Replace(xresimsec, "\kucuk\", "\")

.

Bu satırın nedeni;
kucuk adında klasörde 1-2 kb resimler var, kullanıcı bunları excele ekliyor.
Fakat resim link adresi bir üst klasörde ki büyük ebatlı ayını isimli resim olarak belirlemek için \kucuk\ kısmını siliyorum.
Bu şekilde ekleme anında elimde ki yol bilgisini istediğim şekilde değiştirim link belirliyorum.

 

[Haluk]

Merhaba;

Ben denediğim kadarıyla bir sorun yaşamadım.

Şöyle ki; Excel dosyası masaüstündeyken kodu çalıştırdım, masaüstündeki "kucuk" isimli klasörden resmi seçtim ve yine masaüstünde tek başına duran aynı isimli resme linkledim.

Resme tıklayınca, masaüstünde tek başına duran resim açıldı.

Sizin söz konusu resimlerin isimleri aynı değil mi acaba??
.

 

[mydestek]

Aynı,
Örnek olarak yüklemiş olduğum excel dosyasında resim görünmüyor.
Bu resimleri tekrar nasıl görünür yaparım. 100 den fazla bu şekilde resim var.

 

[Haluk]

Tuhaf bir durum olmakla birlikte, bir de aşağıdaki metodu deneyin;

Sub Test()
    Dim xresimsec As String
    Dim MyObj As Object
    Dim resimyol As String
    Dim Adres As Range
    
    On Error Resume Next
        ActiveSheet.Shapes("MyPic").Delete
    On Error GoTo 0
    
    Set Adres = Selection
    
    xresimsec = Application.GetOpenFilename()
    
    Set MyObj = ActiveSheet.Shapes.AddPicture(xresimsec, False, True, Adres.Left + 4, Adres.Top + 4, Adres.Width - 8, Adres.Height - 8)
    MyObj.Name = "MyPic"
    
    resimyol = Replace(xresimsec, "\kucuk\", "\")
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes("MyPic"), Address:=resimyol
End Sub

 

[mydestek]

Bu kod resim ekliyor, fakat eksi sorunlu resimi düzeltmiyor.
"Bağlantılı resim görüntülenemiyor, Dosya taşımış hatası ... " şeklinde ki resimi nasıl düzeltirim.
Aklıma gelen mevcut resimlerin yol bilgisini okuya bilsem, otomatik resim Sil ve Ekle toplu yaptıra bilir miyim.

Resim ekleme kodunda baştan yaptığım hata şu, resim yol bilgisini excel bir kolona yazmalıydım.
Şimdi o bilgiler ile belki toplu güncelleme mümkün olurdu.

 

[Haluk]

Aşağıdaki gibi bir kodla mevcut hyperlinklerin adreslerini bulabilirsiniz.

MsgBox ActiveSheet.Hyperlinks(1).Address

İşinize yararsa, bunu bir For_Next döngüsü ile geliştirip sayfadaki hücrelere yazdırabilirsiniz.

.

 

[mydestek]

For Next nasıl yazabilirim, birden fazla hücre birleştirilmiş.
Resimleri için nasıl For Next yazarım bilemedim. Aklıma geldi, yazamadım.

 

[Haluk]

Sub Test3()
    For i = 1 To ActiveSheet.Hyperlinks.Count
       Range("D" & i) = ActiveSheet.Hyperlinks(i).Address
    Next
End Sub

.

 

[mydestek]

Sub Test3()
    For i = 1 To ActiveSheet.Hyperlinks.Count
       Range("D" & i) = ActiveSheet.Hyperlinks(i).Address
    Next
End Sub

.

Şimdi sorun sorunlu resimi silmek.
Sonrada sizin yukarıda ki kod yardımı ile tekrar resim ekleme yolu aramak.
Teşekkürler.

 

[Haluk]

Bu arada ...... sayfa üzerindeki resimlerin orjinal dosya yolu için aşağıdaki kodu deneyebilirsiniz .

İşinize yarayacaktır....

C:\Users\LENOVO\Desktop\Mehtap Mutfak Eşyaları\RD\2018\6.6.2018\kucuk\IMG_3706.JPG

gibi adresler elde edeceksiniz.

Sub Test4()
    For i = 1 To ActiveSheet.Shapes.Count
        Range("E" & i) = ActiveSheet.Shapes(i).AlternativeText
    Next
End Sub

.

 

[mydestek]

Yukarı da ki kod ile resim yol bilgileri okudum.
Biraz uğraşayım nasıl toplu resim düzeltiriz. Teşekkür.

 

[Haluk]

Merhaba;

Eğer problemi henüz çözemediyseniz, sorunlu resimlerin olduğu dosyanın önce yedeğini aldıktan sonra, aşağıdaki kodu deneyin.

Sub Test6()
    For i = 1 To ActiveSheet.Shapes.Count
        picPath = ActiveSheet.Shapes(i).AlternativeText
        picLeft = ActiveSheet.Shapes(i).Left
        picTop = ActiveSheet.Shapes(i).Top
        PicWidth = ActiveSheet.Shapes(i).Width
        PicHeight = ActiveSheet.Shapes(i).Height
        
'        ActiveSheet.Shapes(i).Delete
        Set myPic = ActiveSheet.Shapes.AddPicture(picPath, False, True, picLeft, picTop, PicWidth, PicHeight)
        
        ActiveSheet.Shapes(myPic.Name).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Replace(picPath, "\kucuk\", "\")
    Next
    Range("D1").Select
End Sub

.

 

[mydestek]

Merhaba,
Yukarıda ki kod 1004 hatası veriyor.

 

[Haluk]

Yukarıda 1. mesajınız ekindeki dosya üzerinde denedim ve hata vermedi, gayet düzgün çalıştı.

Orjinal dosyanız ve resimleriniz bende olmadığı için bir yorum yapamam.

.

 

[mydestek]

Bene ki dosyayı ekledim.
Bakma şansınız olursa sevinirim.Teşekkür.

 

[Haluk]

Ben, sorunlu resimleri içeren dosyadan bahsetmiştim. Şimdi eklediğiniz dosya, ilk mesajınızda eklediğiniz dosya gibi değil..... yani, içerdiği resimler ve/veya resimleri ekleme metodu farklı olabilir.

Her türlü duruma çözüm üretmek için vaktimi harcayamayacağım, size kolay gelsin.

.

 

[mydestek]

Aynı dosya dosya değişmedi, ilk dosyada resim vardı şimdiki halde resimler var.
Herşey için teşekkür.