Bir sayfada 2 tane Worksheet_SelectionChange

[cimbom05]

İyi günler;
Bir sayfada iki tane Worksheet_SelectionChange olayını tanımlamak mümkün mü?

 

[halit3]

aynısı olmaz ama iç içe olur dosyanı gönder bakalım

 

[cimbom05]

İyi günler Halit3
Söz konusu dosya ektedir. Bahsettiğim olaylardan birisi resim çağırmak ile ilgili olup dosyada çalışmaktadır. İkinci kod ise hücredeki bilgileri açıklamada göstermek üzerine kurgulanmıştır;

II. KOD:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Açıklama As Object
If Intersect(Target, [A4:I9]) Is Nothing Then Exit Sub
On Error GoTo Son
If Not IsEmpty(Target) Then
Set Açıklama = Target.Comment
If Not Açıklama Is Nothing Then
Target.Comment.Delete
End If
Target.AddComment.Text Text:=Target.Text
End If
Son:
End Sub

Ayrıca bu sayfa içerisinde her hangi bir hücreden diğer bir hücreye kopyala yapıştır işlemi yapılamıyor. Biraz fazla oluyor ama bir de bu resim makrosunu yazdıktan sonra C5 hücresindeki KÖPRÜ formülü linkleri bozuluyor ve linkler açılmıyor. İlginiz ve yardımlarınız için teşekkür ederim.

 

[halit3]

bu kodu denermisiniz. diğer sorunu anlayamadım

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Açıklama As Object
If Intersect(Target, [A4:I9]) Is Nothing Then Exit Sub
On Error GoTo Son
If Not IsEmpty(Target) Then
Set Açıklama = Target.Comment
If Not Açıklama Is Nothing Then
Target.Comment.Delete
End If
Target.AddComment.Text Text:=Target.Text
End If
Son:

On Error Resume Next
If Intersect(Target, [g4:g5]) Is Nothing Then GoTo Son1
If Target.Address = "$B$1" Then Exit Sub
If Target.Offset(0, -1).Value & ".JPG" <> "" Then
If UCase(Right(Target.Offset(0, -1).Value & ".JPG", 3)) = "JPG" Or UCase(Right(Target.Offset(0, -1).Value & ".BMP", 3)) = "BMP" Then
Image1.Top = Target.Offset(2, -6).Top
Image1.Left = Target.Offset(2, -6).Left
If Not Image1.Visible Then Image1.Visible = True
If Dir(Cells(1, 1) & Target.Offset(0, -1).Value & ".JPG") <> "" Then
Image1.Picture = LoadPicture(Cells(1, 1) & Target.Offset(0, -1).Value & ".JPG")
Image1.AutoSize = True
Else
'Image1.Picture = Empty
Image1.Visible = False
Image1.Picture = Nothing
End If
Else
GoTo Son1
End If
End If
Exit Sub
Son1:
Image1.Visible = False
Image1.Picture = Nothing
End Sub

 

[cimbom05]

İyi günler, hızlı cevap için teşekkürler.
Belirtmiş olduğunuz kodun ilk bölümünde tanımlanan alanda açıklamalar ile ilgili bölüm çalışıyor. Ancak ikinci aşamadaki resim ile ilgili bölümden sonuç alamadım.
Diğer sorun ile ilgli olarakta bu kodlar sayfaya eklendiğinde;
1- Sayfada kopyala-yapıştır yapamıyorum.
2- C5 hücresinde şu formül bulunmaktadır.
=KÖPRÜ((DÜŞEYARA(C$4;'D:\[kriter.xls]KG'!A$2:Z$1999;7;0));DÜŞEYARA(C$4;'D:\[kriter.xls]KG'!A$2:Z$1999;4;0))
Bu 2009 sayfasını başka bir sayfaya kopyaladığımızda belirtilen link açılmıyor.

Ancak bu 2. madde ile ilgili zamanınızı almayayım. Diğer sorunlarda yardımcı olabilirseniz yeterli olur. Teşekkür ederim.

 

[Arthassss]

Konu aynı olduğu için ayrı bir başlık açmak yerine burdan sormak daha mantıklı geldi. Açıkcası alttaki Halit beyin verdiği koduda bir türlü uyarlayamadım.
Worksheet_SelectionChange olayında eğer "A1:A24" aralığında bir hücre seçilmişse userform1'in , "A25:A50" aralığında bir hücre seçilmişse userform2'nin açılmasını sağlayabilirmiyiz.

 

[dEdE]

Worksheet_SelectionChange olayında eğer "A1:A24" aralığında bir hücre seçilmişse userform1'in , "A25:A50" aralığında bir hücre seçilmişse userform2'nin açılmasını sağlayabilirmiyiz.

Merhaba,
Aradığınız kodlar bu mudur?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A1:A50]) Is Nothing Then Exit Sub
If Intersect(Target, [A25:A50]) Is Nothing Then UserForm1.Show
If Intersect(Target, [A1:A24]) Is Nothing Then UserForm2.Show
End Sub

 

[Arthassss]

Evet aradığım kodlar bunlardı.
Teşekkür ederim.

Merhaba,
Aradığınız kodlar bu mudur?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A1:A50]) Is Nothing Then Exit Sub
If Intersect(Target, [A25:A50]) Is Nothing Then UserForm1.Show
If Intersect(Target, [A1:A24]) Is Nothing Then UserForm2.Show
End Sub

 

[dEdE]

Rica ederim. Güle güle kullanın

 

[janveljan]

İyi günler, hızlı cevap için teşekkürler.
Belirtmiş olduğunuz kodun ilk bölümünde tanımlanan alanda açıklamalar ile ilgili bölüm çalışıyor. Ancak ikinci aşamadaki resim ile ilgili bölümden sonuç alamadım.
Diğer sorun ile ilgli olarakta bu kodlar sayfaya eklendiğinde;
1- Sayfada kopyala-yapıştır yapamıyorum.
2- C5 hücresinde şu formül bulunmaktadır.
=KÖPRÜ((DÜŞEYARA(C$4;'D:\[kriter.xls]KG'!A$2:Z$1999;7;0));DÜŞEYARA(C$4;'D:\[kriter.xls]KG'!A$2:Z$1999;4;0))
Bu 2009 sayfasını başka bir sayfaya kopyaladığımızda belirtilen link açılmıyor.

Ancak bu 2. madde ile ilgili zamanınızı almayayım. Diğer sorunlarda yardımcı olabilirseniz yeterli olur. Teşekkür ederim.

Resim ile ilgili kodun çalışmamasının nedeni farklı olabilir. On Error Resume Next satırını silip öyle deneyin.

 

[janveljan]

İyi günler Halit3
Söz konusu dosya ektedir. Bahsettiğim olaylardan birisi resim çağırmak ile ilgili olup dosyada çalışmaktadır. İkinci kod ise hücredeki bilgileri açıklamada göstermek üzerine kurgulanmıştır;

Ayrıca bu sayfa içerisinde her hangi bir hücreden diğer bir hücreye kopyala yapıştır işlemi yapılamıyor. Biraz fazla oluyor ama bir de bu resim makrosunu yazdıktan sonra C5 hücresindeki KÖPRÜ formülü linkleri bozuluyor ve linkler açılmıyor. İlginiz ve yardımlarınız için teşekkür ederim.

Dosyayı inceledim, aşağıdaki kodları deneyin, hata denetleyen satırları kaldırdım. Bu şekilde deneyin ki kodların neden çalışmadığını nerede hata verdiğini anlayalım. Ayrıca çok fazla birleştirilmiş hücre kullanmışsınız, bunlar hatalara neden olabilir. Örnek olarak açıklama ekleme kısmında birleştirilmiş hücreler bende hata verdi.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Açıklama As Object
If Intersect(Target, [A4:I9]) Is Nothing Then GoTo Son1
On Error GoTo Son
If Not IsEmpty(Target) Then
    Set Açıklama = Target.Comment
        If Not Açıklama Is Nothing Then
        Target.Comment.Delete
        End If
    Target.AddComment.Text Text:=Target.Text
End If
Son:
'On Error Resume Next
If Intersect(Target, [G4]) Is Nothing Then GoTo Son1
yol = Cells(1, 1)
isim = Target.Offset(0, -4).Value
uzantı = ".JPG"
If isim <> "" Then
Image1.Top = Target.Offset(2, -6).Top
Image1.Left = Target.Offset(2, -6).Left
If Not Image1.Visible Then Image1.Visible = True
If Dir(yol & isim & uzantı) <> "" Then
Image1.Picture = LoadPicture(yol & isim & uzantı)
Image1.AutoSize = True
Else
Image1.Visible = False
Image1.Picture = Nothing
End If
Else
GoTo Son1
End If
Exit Sub
Son1:
Image1.Visible = False
Image1.Picture = Nothing
End Sub

 

[cimbom05]

Sayın janjelvan iyi akşamlar,
Söylediğiniz gibi birleştirilmiş hücreler açıklamanın çalışmasını engelliyor. Ancak excel dosyasında oluşturulan bir form yapısı olmasından ve bu formun alt kısımındaki verilerin bulunmasından dolayı birleştirilmiş hücre kullanmam gerekiyor. Yardımlarınız için teşkkür ederim. Bu çalışmayı uygulayamacağız.