• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Optİon Button SeÇİmİne GÖre İlgİlİ Sayfaya Kayit

Katılım
1 Ağustos 2005
Mesajlar
41
Arkadaşlar ekteki programda userformdan girilen verileri senet isimli sayfaya aktarıp ondan sonra seçilen options butana göre ilgili sayfaya da kaydetmem gerekiyor.tabi bu kayıt her saferinde bi alt satıra yapılacak formda bir kaç örneğe baktım ama içinde çıkamadım yardımcı olursanız sevinirim.
 
Yanıt

Bu şekil deneyiniz
Kod:
Private Sub CommandButton1_Click()
[b4] = TextBox1
[b6] = TextBox2
[b8] = TextBox3
[b10] = TextBox4
[b12] = TextBox5
[b14] = TextBox6
End Sub
Private Sub OptionButton1_Click()
Dim SEN, S As Worksheet
Dim i, k As Integer
Set SEN = Sheets("senet")
Set S = Sheets("25000")
son = S.Cells(65536, "b").End(3).Row + 1
k = 1
For i = 2 To 14 Step 2
S.Cells(son, k) = SEN.Cells(i, "b")
k = k + 1
Next
End Sub
Private Sub OptionButton2_Click()
Dim SEN, S As Worksheet
Dim i, k As Integer
Set SEN = Sheets("senet")
Set S = Sheets("100000")
son = S.Cells(65536, "b").End(3).Row + 1
k = 1
For i = 2 To 14 Step 2
S.Cells(son, k) = SEN.Cells(i, "b")
k = k + 1
Next
End Sub
Private Sub OptionButton3_Click()
Dim SEN, S As Worksheet
Dim i, k As Integer
Set SEN = Sheets("senet")
Set S = Sheets("250000")
son = S.Cells(65536, "b").End(3).Row + 1
k = 1
For i = 2 To 14 Step 2
S.Cells(son, k) = SEN.Cells(i, "b")
k = k + 1
Next
End Sub
 
ilginize teşekkür ederim

ilginize teşekkür ederim. şimdide konuyla alakalı bi sıkıntım daha var sizin kodlarınızı aşağıya uyarlayamadım. yardımcı olursanız sevinirim.
Private Sub CommandButton1_Click()
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
MsgBox "Lütfen Harita Ölçeğini Seçiniz.", vbExclamation, "DİKKAT !"
Exit Sub
End If
Sheets("HARİTA TESLİM FİŞİ").Select
Range("f1").Value = TextBox1.Text
Range("a12").Value = TextBox2.Text
Range("c12").Value = TextBox3.Text
Range("e12").Value = TextBox4.Text
Range("g12").Value = TextBox5.Text
Range("a13").Value = TextBox9.Text
Range("c13").Value = TextBox8.Text
Range("e13").Value = TextBox7.Text
Range("g13").Value = TextBox6.Text
Range("a48").Value = TextBox82.Text
Range("h5").Value = TextBox83.Text
Range("a53").Value = TextBox84.Text
Range("h6").Value = TextBox85.Text
Sheets("HARİTA TESLİM FİŞİ").Select
sat = Sheets("teslim kayıt defteri").Cells(65536, "B").End(xlUp).Row + 1
With Sheets("teslim kayıt defteri")
.Cells(sat, "A").Value = Range("f1").Value
.Cells(sat, "B").Value = Range("A12").Value
.Cells(sat, "C").Value = Range("c12").Value
.Cells(sat, "D").Value = Range("e12").Value
.Cells(sat, "E").Value = Range("g12").Value
.Cells(sat, "cd").Value = Range("a48").Value
.Cells(sat, "ce").Value = Range("h5").Value
.Cells(sat, "cf").Value = Range("a53").Value
.Cells(sat, "cg").Value = Range("h6").Value
End With
MsgBox "Teslim Edilen Harita Deftere Kaydedildi..!!", vbOKOnly + vbinf
Sheets("teslim kayıt defteri").Select
Exit Sub
End Sub

bu kodlar sadece "teslim kayıt defteri" sayfası için geçerli ancak "teslim kayıt defteri 2 "ve "teslim kayıt defteri 3" diye 2 sayfa daha ekleyip options button seceneğine göre yukarıdaki makroyu o sayfalara kayıt içinde kullanabilirmiyizçalıştırabilirmiyiz.
 
Sanırım konu birden fazla başlık altında Yardım bekliyor...

Private Sub CommandButton1_Click()

If OptionButton1.Value = True Then
Set S1 = Sheets("teslim kayıt defteri")
ElseIf OptionButton2.Value = True Then
Set S1 = Sheets("teslim kayıt defteri1")
ElseIf OptionButton2.Value = True Then
Set S1 = Sheets("teslim kayıt defteri2")
Else
MsgBox "Lütfen Harita Ölçeğini Seçiniz.", vbExclamation, "DİKKAT !"
Exit Sub
End If

Sheets("HARİTA TESLİM FİŞİ").Select
Range("f1").Value = TextBox1.Text
Range("a12").Value = TextBox2.Text
Range("c12").Value = TextBox3.Text
Range("e12").Value = TextBox4.Text
Range("g12").Value = TextBox5.Text
Range("a13").Value = TextBox9.Text
Range("c13").Value = TextBox8.Text
Range("e13").Value = TextBox7.Text
Range("g13").Value = TextBox6.Text
Range("a48").Value = TextBox82.Text
Range("h5").Value = TextBox83.Text
Range("a53").Value = TextBox84.Text
Range("h6").Value = TextBox85.Text
Sheets("HARİTA TESLİM FİŞİ").Select
sat = S1.Cells(65536, "B").End(xlUp).Row + 1
With S1
.Cells(sat, "A").Value = Range("f1").Value
.Cells(sat, "B").Value = Range("A12").Value
.Cells(sat, "C").Value = Range("c12").Value
.Cells(sat, "D").Value = Range("e12").Value
.Cells(sat, "E").Value = Range("g12").Value
.Cells(sat, "cd").Value = Range("a48").Value
.Cells(sat, "ce").Value = Range("h5").Value
.Cells(sat, "cf").Value = Range("a53").Value
.Cells(sat, "cg").Value = Range("h6").Value
End With
MsgBox "Teslim Edilen Harita Deftere Kaydedildi..!!", vbOKOnly + vbinf
S1.Select
Set S1=Nothing
End Sub
 
TeŞekkÜrler

Benİ Nasil Bİ Sikintidan Kurtardiniz Bİlemezsİnİz.
Kusura Bakmayin Farkli Yerlere İstemeden Yazarak Yardim İstedİm
Çok TeŞekkÜr Ederİm
 
Birşey değil, ben her iki yere de yazmıştım zaten. Kolay gelsin.
 
Geri
Üst