Excel Sayfaya Resim Getirme Hk

skaan

Altın Üye
Katılım
11 Mart 2005
Mesajlar
261
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
12-11-2025
Merhaba;
Personel bilgilerinin oldugu bir sayfam bulunmakta ve bu sayfada belirli bir hucreye
resim sayfası adını verdıgım yine aynı calısma sayfasından isme göre resimleri getirmek istiyordum. Forumda arama yaptım ve asagıdakı kodları buldum. Resimler isme göre geliyor fakat sayfada ornegın alt satıra gecmek ıcın entere basınca resımler belirlediğim hucreden kayboluyor.. Sayfada enter yapınca resımler kayboluyor..
Sızden ricam resımlerın kaybolmasını nasıl engellerım.. Kodu sıze gonderıyorum.. Yardımcı olursanız cok sevınırım.. tesekkurler.. hayırlı gunler dilerim.
Saygılarımla
SKaan
Dosyamda "Personel" ve "Resim" adında iki tane yanyana sayfam bulunmakta. Resim sayfasında resimler duruyor. Personel sayfasında isim sectiğimde resim geliyor fakat bilgi girip entera bastıgımda resım gıdıyor. Ornek dosyamıda gonderıyorum.. Yardımcı olursanız cok sevınırım..
KOD:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Shapes("Resim").Delete
If Target.Address <> "$X$14" Then Exit Sub
Sheets("Resim").Select
ActiveSheet.Shapes([X14]).Copy
[AT6].PasteSpecial
Sheets("Personel").Select
Selection.ShapeRange.Name = "Resim"
[X14].Select
End Sub
 

Ekli dosyalar

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Koyu olan satırın yerini değiştirdim, bir de ufak değişiklik yaptım.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
[B]If Target.Address <> "$X$14" Then Exit Sub[/B]
Application.ScreenUpdating = False
ActiveSheet.Shapes.SelectAll
Selection.Delete
Sheets("Resim").Select
ActiveSheet.Shapes([X14]).Copy
[AT6].PasteSpecial
Sheets("Personel").Select
Selection.ShapeRange.Name = "Resim"
[X14].Select
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,493
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Ben resimlerin xl üzerinde durmaları taraftarı değilim.
Dosyanıza Image nesnesi eklenmiştir.

Resimlerinizin C:\Resimler dizininde olduğu ve resim adlarının da personel adı, soyadı ve .jpg olduğu varsayılarak aşağıdaki kodlar yazılmıştır.


Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [X14]) Is Nothing Then Exit Sub
    Image1.Picture = LoadPicture("")
    Image1.Picture = LoadPicture("C:\Resim\" & Target.Value & ".jpg")
End Sub
 

Ekli dosyalar

skaan

Altın Üye
Katılım
11 Mart 2005
Mesajlar
261
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
12-11-2025
Yardımlarınız için çok teşekkür ederim..
Hayırlı Günler dilerim
Skaan
 

skaan

Altın Üye
Katılım
11 Mart 2005
Mesajlar
261
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
12-11-2025
hamitcan üstadımın hazırladığı kodda sayfaya WordArt yazı ekledıgımde yada baska bir resim eklediğimde isim ile beraber resim değişince yazmıs oldugum WordArt yazı ve yapıstırmıs oldugum baska bir resim siliniyor.. Acaba bu silinmeyi kaldırmanın bir yolu varmı ? Kodda ne gibi bir değişikli yapmamız gerekir.. Bu konuda da çok olmuyorsam yardımcı olursanız benım rapor harika olacak..
Teşekkürler..
Saygılarımla,
SKaan
 
Son düzenleme:
Katılım
24 Haziran 2009
Mesajlar
4
Excel Vers. ve Dili
Excel'07
merhaba. makro kullanmadan giriş yapılan metne göre, daha önce tanımlanmış resmi görüntüleyebilmenin bir yolu var mıdır ?
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
hamitcan üstadımın hazırladığı kodda sayfaya WordArt yazı ekledıgımde yada baska bir resim eklediğimde isim ile beraber resim değişince yazmıs oldugum WordArt yazı ve yapıstırmıs oldugum baska bir resim siliniyor.. Acaba bu silinmeyi kaldırmanın bir yolu varmı ? Kodda ne gibi bir değişikli yapmamız gerekir.. Bu konuda da çok olmuyorsam yardımcı olursanız benım rapor harika olacak..
Teşekkürler..
Saygılarımla,
SKaan
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$X$14" Then Exit Sub
Application.ScreenUpdating = False
Shapes("Resim").SELECT
Selection.Delete
Sheets("Resim").Select
ActiveSheet.Shapes([X14]).Copy
[AT6].PasteSpecial
Sheets("Personel").Select
Selection.ShapeRange.Name = "Resim"
[X14].Select
End Sub
 
Üst