Bul Kaydet kodunda yardım

[fatih34]

Çalışmam da verileri Bul makrosu ile bulduktan sonra kaydet makrosu ile kayıt yapıyorum. Ancak Option Butonlardaki verilerin kaydını yapmak için bir kaç yol denedim işin içinden çıkamadım. Formda da aradım örnek bir çalışma lakin bulamadım. Bu konuda bir yardım



Private Sub cmdbul_Click()
Sheets("Sayfa1").Select
Dim bak As Range
For Each bak In Range("B3:B" & WorksheetFunction.CountA(Range("B3:B65000")))
If bak.Text = TextBox16.Text Then
bak.Select
TextBox5.Text = ActiveCell.Offset(0, 1).Text
TextBox6.Text = ActiveCell.Offset(0, 2).Text
TextBox16.Text = ActiveCell
TextBox7.Text = ActiveCell.Offset(0, 5).Text
TextBox8.Text = ActiveCell.Offset(0, 6).Text

Exit Sub
End If
Next bak
MsgBox "Aradığınız sıra numarası bulnamadı"

End Sub
Private Sub cmdKAYDET_Click()

Dim bak As Range

If TextBox16 = "" Then
MsgBox "Sıra Numarası seçmelisiniz"
Else

For Each bak In Range("B3:B" & WorksheetFunction.CountA(Range("B3:B65000")))
If bak.Text = TextBox16.Text Then
bak.Select
ActiveCell = TextBox16
ActiveCell.Offset(0, 8).Value = TextBox17.Text
ActiveCell.Offset(0, 9).Value = TextBox18.Text
ActiveCell.Offset(0, 10).Value = OptionButton1.Caption
ActiveCell.Offset(0, 11).Value = OptionButton2.Caption
ActiveCell.Offset(0, 12).Value = OptionButton3.Caption
ActiveCell.Offset(0, 13).Value = OptionButton4.Caption
MsgBox "Veriniz kaydedildi", , "KAYIT"
Unload Me
UserForm2.Show

Exit Sub
End If
Next bak
End If
End Sub

 

[Mustafa MUTLU]

ActiveCell.Offset(0, 10).Value = OptionButton1.Caption
ActiveCell.Offset(0, 11).Value = OptionButton2.Caption
ActiveCell.Offset(0, 12).Value = OptionButton3.Caption
ActiveCell.Offset(0, 13).Value = OptionButton4.Caption

Bu kısmı

ActiveCell.Offset(0, 10).Value = OptionButton1
ActiveCell.Offset(0, 11).Value = OptionButton2
ActiveCell.Offset(0, 12).Value = OptionButton3
ActiveCell.Offset(0, 13).Value = OptionButton4

Olarak değiştirip denermisiniz..

 

[fatih34]

Hocam İlginizden dolayı teşekkür ederim. Denedim Doğru,yanlış, yanlış, yanlış olarak kayıt yaptı
eğer mümkünse ekteki dosyaya bakma imkanınız olur mu? Bir kaç yerde takıldım kaldım çalışmam da

 

[Mustafa MUTLU]

ActiveCell.Offset(0, 10).Value = OptionButton1.Caption
ActiveCell.Offset(0, 11).Value = OptionButton2.Caption
ActiveCell.Offset(0, 12).Value = OptionButton3.Caption
ActiveCell.Offset(0, 13).Value = OptionButton4.Caption

Yerine aşağıdaki kodu gir..

If OptionButton1.Value = True Then
Cells(0, 10).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton2.Value = True Then
Cells(0, 11).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton3.Value = True Then
Cells(0, 12).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton4.Value = True Then
Cells(0, 13).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If

4 OptionButton içinde tıklandığında ne yazmasını istiyorsan (Kırmızı yazıyı değiştir) karşısına yaz.

 

[fatih34]

ActiveCell.Offset(0, 10).Value = OptionButton1.Caption
ActiveCell.Offset(0, 11).Value = OptionButton2.Caption
ActiveCell.Offset(0, 12).Value = OptionButton3.Caption
ActiveCell.Offset(0, 13).Value = OptionButton4.Caption

Yerine aşağıdaki kodu gir..

If OptionButton1.Value = True Then
Cells(0, 10).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton2.Value = True Then
Cells(0, 11).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton3.Value = True Then
Cells(0, 12).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If
If OptionButton4.Value = True Then
Cells(0, 13).Value = "[COLOR="red"]ne yazmasını istiyorsan onu yaz[/COLOR]"
End If

4 OptionButton içinde tıklandığında ne yazmasını istiyorsan (Kırmızı yazıyı değiştir) karşısına yaz.

Hocam ilginize teşekkür ederim. Dediğiniz gibi değiştirdim ama aşağıdaki satırda hata gösterdi. Nerede yanlışlık yaptım.
Cells(0, 11).Value = "1"

 

[fatih34]

Sayın hocalarım takıldım kaldım 2 konuda yardım.

 

[Mustafa MUTLU]

Bende normal çalışıyor.
Cells(0, 13) burada 0 yerine 1 yaz dene

 

[fatih34]

Sorun çözüldü mustafa hocam teşekkür ederim.

 

[Mustafa MUTLU]

Sorun çözüldü mustafa hocam teşekkür ederim.

Rica Ederim..