Excel de hücre değerine bağlı resim getirme

[dimdi]

Selam,

Bu konu bir kaç kez açılmış tüm örnekleri inceledim ancak kodları kendi durumuma uyarlayamadım excel bilgim kısıtlı zira ,benim ihtiyaç duyduğum çok basit bir şey

üç farklı isim var , bu üç farklı ismin üç farklı imzası var ,imzalar jpeg ya da jpg olarak sayfa 2 de duruyor , sayfa 1 de imzanın sahibi olan isim hücreden sonuç olarak döndüğünde altında imzanın (jpeg) resmin sayfa 2 den gelmesini istiyorum

bunu nasıl yapabiliriz acaba? örnek excel i ekledim üzerinde kodları görebileceğim şekilde yapabilirsek uyarlayacağım.

Şimdiden ilgilenenlere minnettarım

 

[Merhum İdris SERDAR]

.

http://www.excel.web.tr/f136/personel-bilgileri-resimli-3-rnek-dosya-t22790.html

Buradaki örnekleri inceleyin.

.

 

[dimdi]

yurttas bey,

Mesajımın başında hepsini incelediğimi belirttim zaten , personel örneklerinde listeden data seçildiği için benim anlayacağımın çok üstünde bir excel bilgisi gerektiriyor

o nedenle basit bir şekilde sadece bir sayfadaki resmi diğer sayfadaki ismin yanına koyacak kodlar gerekiyor ,benim personel örneğindeki listeden isim seçip resmi alma olaynı kendi durumuma uyarlamam çok zor

siz ilk mesaja eklediğim örnek üzerinde yapabilir misiniz acaba, onunla ilgili kod?

teşekkür ederim.

 

[snx111]

gerçekte hangi dosyayı Kullanacaksanız O dosyanın boyutunu küçülterek buraya yüklerseniz yardımcı olabiliriz.
Zira hangi hücre hangi sayfa;hangi sıralamalarla kaçıncı hücreye kadar ; resim adı; bunları makroya uyarlamalıyız. Tariflede yapamayacagınız için dosyasız çok zor

 

[dimdi]

snx111 mantık şu;

boş bir hücreye bir forma girilen değere bağlı olarak 1 ,2 ya da 3 rakamı gelecek ,benim istediğim kısım 1 gelirse şu resmi ,2 gelirse bu resmi ,3 gelirse de öteki resmi seçebilen kodu yazmak yani bunun için bir örneğe bile gerek yok aslında ,siz vbscript de istediğiniz gibi değişken tanımlayın sonuçta ana mesele koşul(ki bunlar 1,2,3 olacak istediğiniz hücreden alabilirsiniz) ,1 se sayfa 2 deki resmi sayfa 1 de şuraya koy demek

siz bunu vbscripte yapınca ben gerisini geliştirirm ilk mesajda verdiğim örnek üzerinden yapsanız bile yeter orada birinci sayfada isim , ikinci sayfada resim var ,ismin karşısında 1 yazıyor ,ismin karşısında 1 olursa resim ismin altına gelecek şeklinde vbs kodu gerekli ,

yine de örneği ekliyorum,gerçekte kullanacağı dosya çok büyük ve karmakarışık içinde bir süür vbs objesi var anladığım kadarıyla .

 

[snx111]

1-G22 hücresinde Ahmet İlkar değeri oluşursa sayfa 2 den Picture 3 ü G23 e koy
2-G22 hücresinde mehmet sönmez değeri oluşursa sayfa 2 den Picture 2 i G23 e koy
3-G22 hücresinde güneş tıknaz oluşursa sayfa 2 den Picture 1 i G23 e koy

bu üstteki üç işlemi yapabilecek kodlar gerekiyor hepsi bu

O kadar basite indirgemişsiniz ki anlatırken ; bakkaldan 250 gr leblebi almak bundan daha zormuş gibi geliyor

Kullandığınız office sürümünden pc nizin coğrafik ayarlarından ; kullandığınız dilden tutunda ekran çözünürlüğüne kadar varan bilgiler gerekiyor bağzen sayın Dimdi...

Aynen dediğiniz gibi hiçbir değişken düşünmeden kodlarınızı yazdım ; türkçe karakterileri tanımıyor resimler üstüste biniyor gibi bir sürü negatiflikler çıkacaktır bilginize...

 

[snx111]

buyrun kodlarınız ; yalnız bu resim taşıma konusunda sorunuz olursa ilgilenmeyebilirim !!!!
sayfa2 de a1 den a3 hücresine kadar veri yazmayınız !

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [G22]) Is Nothing Then Exit Sub
On Error Resume Next
Paste
Application.EnableEvents = False
On Error Resume Next
Dim Pic_name As String
Application.ScreenUpdating = False
Range("a1:a5").ClearContents

Sayfa2.Select
For Each Shape In ActiveSheet.Shapes
n = layerCount

If Sayfa2.Range("a1") = "" Then
Sayfa2.Range("a1") = Shape.Name
Set resim1 = Sayfa2.Range("a1")
Else: GoTo 2
2 If Sayfa2.Range("a2") = "" Then
Sayfa2.Range("a2") = Shape.Name
Set resim2 = Sayfa2.Range("a2")
Else: GoTo 3
3 If Sayfa2.Range("a3") = "" Then
Sayfa2.Range("a3") = Shape.Name
Set resim3 = Sayfa2.Range("a3")

End If
End If
End If
Next


If Sayfa1.Range("g22") = "Ahmet ilkar" Then

Worksheets("Sayfa2").Shapes(resim1).Copy
Worksheets("Sayfa1").Paste Range("g23")

End If

If Sayfa1.Range("g22") = "mehmet sönmez" Then

Worksheets("Sayfa2").Shapes("2 Resim").Copy
Worksheets("Sayfa1").Paste Range("g23")
End If
If Sayfa1.Range("g22") = "güneş tıknaz" Then

Worksheets("Sayfa2").Shapes("3 Resim").Copy
Worksheets("Sayfa1").Paste Range("g23")
End If

Sayfa1.Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub