Spreadsheet'de Selection Change olayı

[Arthassss]

Alttaki kod ile sayfa üzerinden b sütununda seçtiğimiz satıra göre userform açılıyor.
Bu kodu userform1 üstündeki Spreadsheet nesnesi üzerinden çalışacak şekilde ayarlamak mümkünmüdür.
Yada farkıl bir kodla yapılabilirse oda işime yarayacaktır.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B5:B500]) Is Nothing Then Exit Sub
If Intersect(Target, [B5:B6]) Is Nothing Then GoTo Son
On Error GoTo Son
UserForm2.Show
Son:
If Intersect(Target, [B7:B300]) Is Nothing Then GoTo Son1
On Error GoTo Son
UserForm3.Show
Son1:
If Intersect(Target, [B301:B400]) Is Nothing Then GoTo Son2
On Error GoTo Son
UserForm4.Show
Exit Sub
Son2:
If Intersect(Target, [B401:B500]) Is Nothing Then Exit Sub
On Error GoTo Son
UserForm5.Show
Exit Sub
End Sub

 

[hamitcan]

Galiba Spreadsheet nesnesi Intersect fonksiyonunu tanımıyor. Ama aşağıdaki şekilde çalışdı.

Private Sub Spreadsheet1_SelectionChanging(ByVal Target As OWC11.Range)
    If Target.Row < 5 Then Exit Sub
    If Target.Row > 500 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    UserForm2.Show
End Sub

 

[Arthassss]

Sn. Hamitcan yardımınız için teşekkür ederim.
Birde bu kodu 2 yada daha fazla userformu çalıştıracak şekilde revize etmemiz mümkünmüdür.
Yani "B5:B6" aralığı için userform2'yi, "B7:B32" aralığı için userform3' ü ve "B33:B500" aralığı içinde userform4' ü açacak şekilde düzenlememiz mümkünmüdür?

Alttaki kodla onuda ayarladım.

Private Sub Spreadsheet1_SelectionChanging(ByVal Target As OWC11.Range)
If Target.Row < 7 Then
If Target.Row < 5 Then Exit Sub
If Target.Row > 6 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
UserForm2.Show
Else
If Target.Row < 33 Then
If Target.Row < 7 Then Exit Sub
If Target.Row > 32 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
UserForm3.Show
Else
If Target.Row < 33 Then Exit Sub
If Target.Row > 500 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
UserForm4.Show
End If
End If
End Sub

 

[hamitcan]

Bir de böyle dener misiniz ?

Private Sub Spreadsheet1_SelectionChanging(ByVal Target As OWC11.Range)
    If Target.Column <> 2 Then Exit Sub
    Select Case Target.Row
        Case 5 To 50: UserForm2.Show
        Case 51 To 150: UserForm3.Show
        Case 151 To 500: UserForm4.Show
    End Select
End Sub

 

[Arthassss]

Hocam teşekkür ederim ilk kodunuzu düzenlemiştim. O şekilde daha çok işime yarar zira farklı kolonlardanda seçme şansı veriyor.
Saygılar.....

 

[Arthassss]

Biraz fazla oldum ama bu seferde Userformun initialize olayındaki sayfadaki veriyi Spreadsheet1'e kopyalayan kod yüzünden UserForm1'in açılışı esnasında UserForm2'de açılıyor.
"Spreadsheet1.[B5].Paste" kodundan sonra "Unload UserForm2" şeklinde bir kod yazıp kapatmayı denedim ama malesef işe yaramıyor.
Bu formun "UserForm_Initialize" olayı esnesında hiç açılmamasını yada açılsa bile ekrana gelmeden geri kapanmasını sağlayabilirmiyiz?

Private Sub UserForm_Initialize()
Dim cell As Range
Dim rng As Range
For Each cell In Range("B5:R5000")
If cell.Interior.ColorIndex = 1 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
If Not rng Is Nothing Then
rng.Select
End If
Selection.Copy
Spreadsheet1.[B5].Paste
Application.CutCopyMode = False
Range("A1").Select
End Sub

 

[hamitcan]

Private Sub UserForm_Initialize()
    Spreadsheet1.[B5] = [a1].Value
End Sub

şeklinde deneyin.

 

[Arthassss]

Hocam o şekilde formu açıyor fakat bu seferde forma veri kopyalama işlemini yapmıyor. Benim önce veriyi kopyalayıp sonra açılan UserForm2' nin kendiliğinden kapanmasını sağlamam lazım.

 

[hamitcan]

Kullanılmış bölgeyi spreadsheet içine mi aktarmak istiyorsunuz ? Çözümü buna göre düşünelim.

 

[Arthassss]

Sn.Hamitcan;
Üstteki kodla userform1 açılırken sayfa üzerinde "B5:R5000" aralığındaki, siyah renkli, hücreleri seçip aynı form üzerindeki"Spreadsheet1" nesnesi üzerine kopyalıyor. bu kopyamayıda "B5" hücresinden başlayarak yaptığı için "Spreadsheet1_SelectionChanging" olayından dolayı userform2 yi yapıştırmadan önce açıyor ve o sayfada bekliyor. Nezamanki userform2 kapatılırsa ozaman kod devam ediyor. Bense "UserForm1'in _Initialize" olayında bu userform2 nin hiç takılmadan açılıp tekrar kapanmasını yada hiç açılmamasını istiyorum.
Sayfa çok yüklü ekleyemedim Pazartesi sabah temizleyip bir örnek dosya eklerim, ona göre çözmeye çalışırız.
Saygılar....

 

[Arthassss]

Sn.Hamitcan,
Örnek bir dosya ekledim.
Açılışta userform1 den önce açılan userform2 nin mümkünse hiç açılmamasını yada açılsa dahi ekrana gelmeden geri kapanmasını istiyorum.
UserForm2'nin açılmaması gibi bir olay mümkünse bu ilk tercihim olur.

 

[Korhan Ayhan]

Selamlar,

UserForm2 nesnesini açan koddan önce kopyalama işlemini kontrol eden aşağıdaki sorguyu kullanarak formun açılışını kontrol altına alabilirsiniz.

If Application.CutCopyMode <> xlCopy Then

 

[Arthassss]

Sn. Ayhan,
Verdiğiniz kodusayfadaki veriyi "Spreadsheet1" üzerine yapıştırma işini yapan alttaki kodda "Spreadsheet1.[B5].Paste" nin önüne yazdığımda malesef bu seferde veriyi sayfadan "Spreadsheet1" üzerine yapıştırmıyor.
Benmi beceremedim yoksa eklemem gereken başka bir kod dahamı var?

Sub renklihucrelerıkopyala()
Dim cell As Range
Dim rng As Range
For Each cell In Range("B5:R5000")
If cell.Interior.ColorIndex = 1 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
If Not rng Is Nothing Then
rng.Select
End If
Selection.Copy
Spreadsheet1.[B5].Paste
Application.CutCopyMode = False
Range("A1").Select
End Sub

 

[Korhan Ayhan]

Selamlar,

Yanlış koda uygulamaya çalışıyorsunuz. Bahsettiğiniz kodda UserForm2 nesnesini açan bir kod yok. Aşağıdaki kodda kırmızı renkli değişikliği yapın.

Private Sub Spreadsheet1_SelectionChanging(ByVal Target As OWC11.Range)
    If Target.Row < 7 Then
    If Target.Row < 5 Then Exit Sub
    If Target.Row > 6 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
[COLOR=red]    If Application.CutCopyMode <> xlCopy Then
    UserForm2.Show
    End If
[/COLOR]    Else
    If Target.Row < 400 Then
    If Target.Row < 7 Then Exit Sub
    If Target.Row > 399 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    UserForm3.Show
    Else
    If Target.Row < 400 Then Exit Sub
    If Target.Row > 500 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    UserForm4.Show
    End If
    End If
End Sub

 

[Arthassss]

Sn. AYhan teşekkür ederim.
Saygılar....