Excel hücresine makro ile resim getirme

[Haluk]

Merhaba,

Dosyayı bilgisayardan silmiştim, bende de yok.... ama kullanılan kod 3. mesajda var zaten.

.

 

[gicimi]

Tamamdır haluk bey. Kod için teşekkürler.

 

[dogu34]

Ekli dosyayı indirip, Excel dosyasını açın. Sayfadaki butona tıklayın .....

https://drive.google.com/open?id=1sPkBfmRp0kCA7A2yh3QYFlALNHmI6lod

.

Hocam merhaba elinize sağlık bizde yararlanmış olduk.Bir sorum olacak resim bulunamadı yerine, resmi olmayan ürünlerin resim alanına,resim yok adında jpg görseli nasıl koyabiliriz
Teşekkürler

 

[Haluk]

Hocam merhaba elinize sağlık bizde yararlanmış olduk.Bir sorum olacak resim bulunamadı yerine, resmi olmayan ürünlerin resim alanına,resim yok adında jpg görseli nasıl koyabiliriz
Teşekkürler

....
...
..
        PicFile = ThisWorkbook.Path & "\Resimler\" & Range("A" & i).Text & ".jpg"
        If Dir(PicFile) = Empty Then
            PicFile = ThisWorkbook.Path & "\Resimler\ResimYok.jpg"
        End If
....
..
.

.

 

[dogu34]

Teşekkürler hocam emeğinize sağlık iyi akşamlar

 

[sosyete33]

Değerli üstatlar ve yardımsever üyeler ne zamandan beri faydalandığım ve müteşekkir kaldığım bu kıymetli forumda hepinize selamlar,

Excelde, bilgisayarın içindeki resimleri excel hücresinin içine tam sığacak şekilde getirtmek istiyorum.

Çalışacağım excelde yüzlerce satır olacak.

Resimlerin isimleri exceldeki her bir satırda yazıyor ve hepsinin windowstaki yeri aynı. Bir resmin adı 14567.jpg ise bir diğerkinin 677899.jpg gibi.

Bu gelen resimleri hücrenin içine tam sığacak şekilde gelsin istiyorum.

Bir resim üzerinden gitmek gerekirse, resmin windows'taki adresi bu diyelim.

Q:\Users\manyakbiri\Desktop\Sadece Bana Ait\Birtakım Resimler\14567.jpg

Bir alttaki satırın adresi şu olacak;

Q:\Users\manyakbiri\Desktop\Sadece Bana Ait\Birtakım Resimler\677899.jpg

Yapmak istediğim işin çok basit ekran görütünsü de burada. Bence bu iş yapılabilir. B2 hücresinden itibaren resimlerin taşmayacak şekilde tam olarak hücrenin içine gelmesini istiyorum.
Eğer yardımcı olursanız çok memnun olurum.



Cevaplarınızı bekleyeceğim.

merhaba Bu makrodan hareketle yerleşimin yatay olmasını istiyorum yardımlarınızı rica ederim
https://photos.app.goo.gl/XWKjqeMNfq8w1nyr6

 

[BaY_KaPTaN]

merhaba Bu makrodan hareketle yerleşimin yatay olmasını istiyorum yardımlarınızı rica ederim
https://photos.app.goo.gl/XWKjqeMNfq8w1nyr6

Siz zaten sütunun genişlik ve yüksekliğini nasıl ayarlarsanız ona göre resmi sığdırıyor.

 

[sosyete33]

yok anlatmak istediğim bu makro ile yukarıdan aşağıya doğru resimler sıralanıyor , benim ihtiyacamı olan soldan sağa doğru , yani A sutüna yazıp B de resim çıkması değilde , satır 2 yazınca resim satır 1 de çıkmasını istiyorum

 

[BaY_KaPTaN]

yok anlatmak istediğim bu makro ile yukarıdan aşağıya doğru resimler sıralanıyor , benim ihtiyacamı olan soldan sağa doğru , yani A sutüna yazıp B de resim çıkması değilde , satır 2 yazınca resim satır 1 de çıkmasını istiyorum

Anladım.
B Sütununa yazılan resimleri, A sütununa getirmek istiyorsunuz.
Aşağıdaki şekilde deneyin.

NOT: ActiveSheet.Pictures.Delete ' Tüm Resimleri Siler Sonra Ekler. Üst Üste resim gelmemesi için ekleme yapılmıştır.

Sub Test()
    ' Haluk - 15/06/2019
    ' sa4truss@gmail.com
    '
    Dim NoA As Long, i As Long
    Dim PicFile As String, PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer
    NoA = Range("B" & Rows.Count).End(xlUp).Row

ActiveSheet.Pictures.Delete ' Tüm Resimleri Siler Sonra Ekler. Üst Üste resim gelmemesi için eklenmiştir.
    For i = 2 To NoA
        PicFile = ThisWorkbook.Path & "\Resimler\" & Range("B" & i).Text & ".jpg"
        If Dir(PicFile) = Empty Then
            Range("A" & i) = "Resim bulunamadı..!"
            GoTo ResumeFor:
        End If
        PicTop = Range("A" & i).Top
        PicLeft = Range("A" & i).Left
        PicW = Range("A" & i).Width
        PicH = Range("A" & i).Height
        Set MyPic = ActiveSheet.Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)
ResumeFor:
    Next
End Sub

 

[sosyete33]

ilginiz için teşekkürler , resim ekleyebilsem daha iyi anlatabilirim , A2 ye kodu yazınca A1 de resim , b2 ye kodu yazınca b1 de resim ..... şeklinde