Oklarla değişen hücredeki değere göre veri atama

[reflargon]

Merhaba

Sorunumu anlatmak biraz karışık yardımcı olabilrseniz çok sevineceğim.

A sütununda yön oklarıyla gezdiğimde, üzerindeki bulunduğum hücredeki değerin C2 hücresine aktarılmasını istiyorum.

Oradaki değişikliğe müteakipte resim yenilenecek. Benim tek ihtiyacım üzerinde gezindiğim hücreleri vba da nasıl gösteririm. Üzerinde bulunduğum hücredeki veriyi hücre içine girmeden nasıl kullanırım.

Ustalarıma şimdiden teşekkürler.

Not: Üzerinde çalıştığım bir örneği ekliyorum.

 

[İhsan Tank]

Merhaba

Sorunumu anlatmak biraz karışık yardımcı olabilrseniz çok sevineceğim.

A sütununda yön oklarıyla gezdiğimde, üzerindeki bulunduğum hücredeki değerin C2 hücresine aktarılmasını istiyorum.

Oradaki değişikliğe müteakipte resim yenilenecek. Benim tek ihtiyacım üzerinde gezindiğim hücreleri vba da nasıl gösteririm. Üzerinde bulunduğum hücredeki veriyi hücre içine girmeden nasıl kullanırım.

Ustalarıma şimdiden teşekkürler.

Not: Üzerinde çalıştığım bir örneği ekliyorum.

merhaba
kodu bununla değişiniz

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A9:A65536")) Is Nothing Then Exit Sub
Range("C2") = ActiveCell
If Intersect(Target, Range("c2")) Is Nothing Then Exit Sub
Sheets("veriler").Range("C2").Value = ActiveCell.Value
Dim resimler As Integer
Dim hucre As String
Dim i As Integer
resimler = ActiveSheet.Pictures.Count
For i = 1 To resimler
ActiveSheet.Pictures(1).Delete
Next
Range("a2").Select
'ActiveSheet.Pictures.Insert("\\****************\" & Range("c2").Text & ".jpg").Select
'Selection.ShapeRange.Height = 150
'Selection.ShapeRange.Width = 150
End Sub

 

[reflargon]

Merhaba

Öncelikle teşekkürler. Maalesef resimleri getiremiyor. İki intersect çakışıyor olabilir mi?
Sayfada iki tetik var.
ilk tetik; A5 ile A50 arasındaki seçili hedefi C2 hücresine gönderecek.
İkinci tetik; ise C2 hücresindeki değere göre resmi çağıracak.

kısaca ben A sütununda oklarla ilerlerken yukarıda resim değişecek.

 

[İhsan Tank]

Merhaba

Öncelikle teşekkürler. Maalesef resimleri getiremiyor. İki intersect çakışıyor olabilir mi?
Sayfada iki tetik var.
ilk tetik; A5 ile A50 arasındaki seçili hedefi C2 hücresine gönderecek.
İkinci tetik; ise C2 hücresindeki değere göre resmi çağıracak.

kısaca ben A sütununda oklarla ilerlerken yukarıda resim değişecek.

resim değişir mi bilmiyorum çünkü elimde resim yok

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
If Intersect(Target, Range("A5:A65536")) Is Nothing Then Exit Sub
Range("C2") = ActiveCell
End If
If Target.Column = 2 Then
If Intersect(Target, Range("c2")) Is Nothing Then Exit Sub
Sheets("veriler").Range("C2").Value = ActiveCell.Value
Dim resimler As Integer
Dim hucre As String
Dim i As Integer
resimler = ActiveSheet.Pictures.Count
For i = 1 To resimler
ActiveSheet.Pictures(1).Delete
Next
End If
Range("a2").Select
'ActiveSheet.Pictures.Insert("\\****************\" & Range("c2").Text & ".jpg").Select
'Selection.ShapeRange.Height = 150
'Selection.ShapeRange.Width = 150
End Sub

bu kodu dener misiniz bir de

 

[ynmcan]

Merhaba

Sorunumu anlatmak biraz karışık yardımcı olabilrseniz çok sevineceğim.

A sütununda yön oklarıyla gezdiğimde, üzerindeki bulunduğum hücredeki değerin C2 hücresine aktarılmasını istiyorum.

Oradaki değişikliğe müteakipte resim yenilenecek. Benim tek ihtiyacım üzerinde gezindiğim hücreleri vba da nasıl gösteririm. Üzerinde bulunduğum hücredeki veriyi hücre içine girmeden nasıl kullanırım.

Ustalarıma şimdiden teşekkürler.

Not: Üzerinde çalıştığım bir örneği ekliyorum.

Syn. Reflargon;
Kırmızı ile belirtiğim satırı en başa getirin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

[COLOR="Red"]Sheets("veriler").Range("C2").Value = ActiveCell.Value[/COLOR]
 If Intersect(Target, Range("c2")) Is Nothing Then Exit Sub
 
 Dim resimler As Integer
Dim hucre As String
Dim i As Integer
resimler = ActiveSheet.Pictures.Count
For i = 1 To resimler
ActiveSheet.Pictures(1).Delete
Next

Range("a2").Select

    'ActiveSheet.Pictures.Insert("\\****************\" & Range("c2").Text & ".jpg").Select
    'Selection.ShapeRange.Height = 150
    'Selection.ShapeRange.Width = 150
    
End Sub

 

[reflargon]

Teşekkürler

Ancak bu kodla da resimler gelmedi. Ve ben sanırım problemi anladım. Kodla değiştirilen C2 hücresi sayfada yapılan bir değişiklik olarak algılanmadığı için resmi çağırmıyor. Eğer C2 hücresine tıklarsam çalışıyor.

Kodu aşağıdaki şekilde uyarladım ancak bu şekilde resmin konumunu belirleyemedim. Eğer bana "Selection.ShapeRange.Height = 150" gibi resmin 0,0 kordinatından başlatacak bir opsiyon biliyorsanız söylerseniz işim tamamlanacaktır.

Not: Picturebox kullanarak da bir yöntem bulunabilir sanırım. Her fikre açığım

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("c2").Value = ActiveCell
If Intersect(Target, Range("c2")) Is Nothing Then Exit Sub

Dim resimler As Integer
Dim hucre As String
Dim i As Integer
resimler = ActiveSheet.Pictures.Count
For i = 1 To resimler
ActiveSheet.Pictures(1).Delete
Next


ActiveSheet.Pictures.Insert("C:\Documents and Settings\owner\Desktop\LogoList\" & Range("c2").Value & ".jpg").Select
Selection.ShapeRange.Height = 150
Selection.ShapeRange.Width = 150
ActiveCell.Select
End Sub

 

[reflargon]

İmajebox ekleyerek ve aşağıdaki şekilde kodlayarak sorun çözülmüştür. İlgilenenlere çok çok teşekkür ederim. Aklınıza sağlık..


Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A5:A5000")) Is Nothing Then Exit Sub

Range("c2").Value = ActiveCell
Image1.Picture = LoadPicture("C:\Documents and Settings\owner\Desktop\LogoList\" & Range("c2").Value & ".jpg")
ActiveCell.Select
End Sub