İstenİlen HÜcreye Resİm YerleŞtİrme

[frksfu]

Sn Ustalar resim konusundaki tümsitedeki konuları aradım ancak benim istediğimi bulamadım. Benim istediğim bir hücreye isim yazınca yanındaki hücreye resim gelsin. İstediğimi anlatan dosyam ekte şimdiden çok teşekkür ederim.

 

[Mdemir63]

Sn Ustalar resim konusundaki tümsitedeki konuları aradım ancak benim istediğimi bulamadım. Benim istediğim bir hücreye isim yazınca yanındaki hücreye resim gelsin. İstediğimi anlatan dosyam ekte şimdiden çok teşekkür ederim.

Selamlar,

Comboboxla yapılmış küçük bir örnek incelermisiniz.

Bende siteden öğrendiklerimle yapmaya çalıştım. Fikir vermesi açısından belki işinize yarar.

Kolay gelsin

 

[leumruk]

Syn. Komutan63 konuyla hiç alakası yok ama bir sorum olacak. Sayfaya comboboxu nasıl yerleştirdiniz ve isimleri veri sayfasından görmesini nasıl sağladınız, açıklar mısınız. Kodlara baktım birşey göremedim.

 

[Mdemir63]

Syn. Komutan63 konuyla hiç alakası yok ama bir sorum olacak. Sayfaya comboboxu nasıl yerleştirdiniz ve isimleri veri sayfasından görmesini nasıl sağladınız, açıklar mısınız. Kodlara baktım birşey göremedim.

Selamlar,

Ekteki resim dosyasını incelermisiniz. Umarım açıklayıcı olmuştur.

Kolay gelsin

 

[leumruk]

Syn. komutan63,
Siz gayet güzel açıklamışsınız, fakat ben combobox'u oluşturamadım. Benim üst ekranda da yok. Görünüm,araç çubukları, formlar'dan buna benzer birşey buldum. Fakat sanırım aynısı değil. Açılır liste oluşturuyor ve sağ tıklayınca Özellikler yerine denetim biçimlendir çıkıyor. Bu combobox'un tam yerini tarif eder misiniz?

 

[Mdemir63]

Selamlar,

Excel sayfası açın, Üstteki araç çubuklarının olduğu boş olan bir yerde sağ klik yapın açılan pencereden Visual Basıc çek et. Araç çubuklarının olduğu yere yeni araç çubukları oluşacak. oluşan araç çubuğunun üzerinde çekiç ve ay anahtar olan araç çubuğuna tıkladığında Combobox sında olduğu yeni araç çubuklarını göreceksiniz.

Umarım anlatabilmişimdir.

Kolay gelsin

 

[leumruk]

Tamamdır, buldum. Araç çubuklarını tek tek denedim. Denetim Araç Çubuğuymuş. Açıklamalar için teşekkürler.
İyi geceler...

 

[Mdemir63]

Rica ederim.

Sizede iyi geceler

 

[tahsinanarat]

Resimekle

Düşündüğünüzü tahmin ederek birşeyler yapmaya çalıştım,
kendinize göre uyarlarsınız

 

[frksfu]

Deerli arkadaşlar benim istediğim herhangi bir hücreye ARA komutu ile bir isim çağırtıp bu gelen isme göre yandaki hücreye resim gelmesi sizlerin önerilerinizi bu forumda daha değişikleri ile buldum ancak istediğim başka birşey.

 

[tahsinanarat]

ilk mesajınızda eklediğiniz örnekten anlaşılan, çağırılan kişiye ait resmin g4 hücresine gelmesi yönünde idi.
1- C4 HÜCRESİNE BİR RAKAM YAZIYORUM VE E4 HÜCRESİNDE BİR İSİM GELİYOR (VERİ SAYFASINDAN) 2- İSTEĞİM E4 HÜCRESİNE İSİM YAZINCA G4 HÜCRESİNE KİŞİNİN RESMİNİN GELMESİ 3- KİŞİLERİN RESİMLERİ C:\RESİMLERİM KLASÖRÜNDE
Ancak bu şekilde istemediğinizi söylüyorsunuz,
Herhangi bir hücrede yazdığınız ismin sağınamı resmin gelmesini istiyorsunuz

 

[frksfu]

Herhalde İyİ Anlatamadim
2 - E4 HÜcresİne İsİm Yazinca G4 HÜcresİne KİŞİnİn Resmİnİn Gelmesİ Satirindakİ "İsİm Yazinca" Kelİmelerİ YanliŞ AnlaŞmaya Sebep Oldu Herhalde "İsİm Yazinca" Yerİne "İsİm Gelİnce" Dİye Okuyunuz , ÇÜnkÜ İsmİ C4 Te Aratiyoruz Ve Resİm G4 HÜcresİne Gelİcek

 

[frksfu]

Anlaşılıyorki bu konuda kimse yardım edemedi benim isteğim anlamsızmış. Genede ilgilenen herkese teşekkür ederim

 

[Ferhat Pazarçevirdi]

Anlaşılıyorki bu konuda kimse yardım edemedi benim isteğim anlamsızmış. Genede ilgilenen herkese teşekkür ederim

Aşağıdaki kodu "Sayfa1" adlı sheet'in kod modulüne kopyalayınız.

Option Explicit
Const yoL As String = "C:\Resimlerim\"
Const dosyaUzantisi As String = ".jpg"
'-----------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rsm As Picture
    Dim oran As Double
    
    If Target.Address = Range("C4").Address Then
        
        For Each rsm In ActiveSheet.Pictures
            If Not Intersect(Range("G4"), rsm.TopLeftCell) Is Nothing Then
                rsm.Delete
            End If
        Next
        
        If Len(Dir(yoL & Range("E4") & dosyaUzantisi)) > 0 Then
            
            
            Set rsm = ActiveSheet.Pictures.Insert(yoL & Range("E4") & dosyaUzantisi)
            
            With rsm
                .Left = Range("G4").Left
                .Top = Range("G4").Top
                oran = .Width / .Height
                .Height = Range("G4").Height
                .Width = .Height * oran
            End With
        
        End If
    End If
    Set rsm = Nothing
End Sub

 

[frksfu]

Sayın Ferhat Pazarçevirdi inanın artık ümidimi yitirirmiştim ve başka bölümede konu açmıştım çok teşekkür ederim iyiki varsınız sizlerin sayesinde birşeyler hem öğreniyoruz hemde yapıyoruz. 50 yaşından sonra bana exceli sevdirdiniz adeta müptela oldum başka bir siteyi artık açmıyorum. sağolun var olun

 

[Ferhat Pazarçevirdi]

Rica ederim, bir şeylere vesile olduysak ne ala ...

Kolay gelsin.