userform1 deki textboxların bilgilerini toplu yazdırma

burhancavus61

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
userform1 deki bütün textboxlardaki (20-25 civarında textbox var) bilgileri toplu olarak data sayfasının 2. satırından itibaren nasıl yazdırırım
hepsini tek tek yazmak zor
 
C

class37

Katılım
17 Ağustos 2004
Mesajlar
222
Excel Vers. ve Dili
Ofiste Excel 2000 Türkçe
Evde Excel 2003 Türkçe
Merhaba
TextBox İsimlerini Kendi çalışmanıza uyarlayınız.Sıra No vererek verileri alt alta kaydeder.
Kod: 
Private Sub CommandButton1_Click()
Sheets("Data").Select
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a2").Value = Empty Then
Range("a2Value = 1
Range("A2").Select
Else

ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If

ActiveCell.Offset(0, 1) = ad
ActiveCell.Offset(0, 2).Value = tar.Text
ActiveCell.Offset(0, 3).Value = mno.Text
ActiveCell.Offset(0, 4).Value = P43.Text 
ActiveCell.Offset(0, 6).Value = TextBox1.Text
ActiveCell.Offset(0, 7).Value = TextBox2.Text
ActiveCell.Offset(0, 8).Value = TextBox3.Text
ActiveCell.Offset(0, 9).Value = TextBox4.Text
ActiveCell.Offset(0, 10).Value = TextBox5.Text
ActiveCell.Offset(0, 11).Value = TextBox6.Text
ActiveCell.Offset(0, 13).Value = TextBox8.Text
ActiveCell.Offset(0, 14).Value = TextBox9.Text
ActiveCell.Offset(0, 15).Value = TextBox10.Text
ActiveCell.Offset(0, 16).Value = TextBox11.Text
ActiveCell.Offset(0, 17).Value = TextBox12.Text
ActiveCell.Offset(0, 18).Value = TextBox13.Text
ActiveCell.Offset(0, 19).Value = TextBox14.Text
ActiveCell.Offset(0, 20).Value = TextBox15.Text
ActiveCell.Offset(0, 21).Value = TextBox16.Text
ActiveCell.Offset(0, 22).Value = TextBox17.Text
ActiveCell.Offset(0, 23).Value = TextBox18.Text
ActiveCell.Offset(0, 24).Value = TextBox19.Text
ActiveCell.Offset(0, 25).Value = TextBox20.Text
ActiveCell.Offset(0, 26).Value = TextBox21.Text
ActiveCell.Offset(0, 27).Value = TextBox22.Text
ActiveCell.Offset(0, 28).Value = TextBox23.Text
ActiveCell.Offset(0, 29).Value = TextBox24.Text
ActiveCell.Offset(0, 30).Value = TextBox25.Text
ActiveCell.Offset(0, 31).Value = TextBox26.Text
ActiveCell.Offset(0, 32).Value = TextBox27.Text
ActiveCell.Offset(0, 33).Value = TextBox28.Text
ActiveCell.Offset(0, 34).Value = TextBox29.Text
ActiveCell.Offset(0, 35).Value = TextBox30.Text
ActiveCell.Offset(0, 36).Value = TextBox31.Text
ActiveCell.Offset(0, 37).Value = TextBox32.Text
ActiveCell.Offset(0, 38).Value = TextBox33.Text
ActiveCell.Offset(0, 39).Value = TextBox34.Text
ActiveCell.Offset(0, 40).Value = TextBox35.Text
ActiveCell.Offset(0, 41).Value = TextBox36.Text
ActiveCell.Offset(0, 42).Value = TextBox37.Text
ActiveCell.Offset(0, 43).Value = TextBox38.Text
ActiveCell.Offset(0, 44).Value = TextBox39.Text
ActiveCell.Offset(0, 45).Value = TextBox40.Text
ActiveCell.Offset(0, 46).Value = TextBox41.Text
ActiveCell.Offset(0, 47).Value = TextBox42.Text

  
End Sub
 
burhancavus61

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
ya hocam elimde şöyle bi kod var bunun neresinde textboxlarla ilgili bilgi var düğmeye tıklatınca dataya kayıt yapıyor anlamadım gitti kodlar aşağıda


Private Sub CommandButton21_Click()
'ComboBox2.Value = TextBox4.Value
Dim bak As Range
Dim say As Integer
Sheets("data").Select
For Each bak In Range("c1:c32000")
If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox9.Value, vbUpperCase) Then
MsgBox "Bu sayılı ihale kaydınız var.Lütfen Kontrol Ediniz!"
TextBox9.SetFocus
Exit Sub
End If
Next bak
Dim k As Integer
For k = 2 To 32000
Sheets("data").Select
Cells(k, 2).Select
If Cells(k, 2).Value = "" Then
'Cells(k, 1).Value = ComboBox2.Value
GoTo kayit:
End If
Next k
kayit:
Application.ScreenUpdating = False
Sheets("data").Select
Dim m As Integer
For m = 9 To 215
ActiveCell.Value = 1
ActiveCell.Offset(0, m - 8).Value = Controls("TextBox" & m).Value
Next m
'ActiveCell.Offset(0, 26).Value = ComboBox1.Value
'TextBox26.Value = ""
'Workbooks("vvvv").Save
MsgBox ("Veri Tabanına Kayıt Yapıldı.")

End Sub

Private Sub CommandButton22_Click()
If CheckBox1.Value = False And CheckBox2.Value = False Then
MsgBox ("Lütfen Ã?nce Arama Kriterlerini belirleyiniz")
Exit Sub
Else
End If
If CheckBox1.Value = True Then
If ComboBox1.Value = "" Then
MsgBox ("Lütfen İhale Kayıt Numarasını listeden işaretleyiniz!")
ComboBox1.SetFocus
Exit Sub
Else
End If
Dim bak As Range
Dim say As Integer
Sheets("data").Select
For Each bak In Range("c2:c20000")
If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
'MsgBox "Bu isimde bir kaydınız bulundu"
Range(bak.Address).Select
'ActiveCell(1, -23).Select
'Exit Sub
GoTo ekran:
End If
Next bak
On Error Resume Next

Dim p As Integer
For p = 9 To 215
Controls("TextBox" & p).Value = ""
Next p
MsgBox ("Kayıt bulunamadı.")
Exit Sub
ekran:
On Error Resume Next


Dim m As Integer
For m = 9 To 215
Controls("TextBox" & m).Text = ActiveCell.Offset(0, m - 9).Text
Next m
'TextBox18.Value = Format(TextBox18, "hh:mm")
TextBox41 = Replace(TextBox41, ",", ".")
TextBox42 = Replace(TextBox42, ",", ".")
TextBox43 = Replace(TextBox43, ",", ".")
TextBox44 = Replace(TextBox44, ",", ".")
TextBox45 = Replace(TextBox45, ",", ".")
TextBox46 = Replace(TextBox46, ",", ".")


TextBox216.Value = 1
MsgBox ("Dosya bulundu.")

Exit Sub

End If
If CheckBox2.Value = True Then
If ComboBox1.Value = "" Then
MsgBox ("Lütfen İhale Adını listeden işaretleyiniz!")
ComboBox1.SetFocus
Exit Sub
Else
End If
Dim bakk As Range
Dim sayy As Integer
Sheets("data").Select
For Each bakk In Range("j2:j20000")
If StrConv(bakk.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
'MsgBox "Bu isimde bir kaydınız bulundu"
Range(bakk.Address).Select
ActiveCell(1, -6).Select
'Exit Sub
GoTo ekrann:
End If
Next bakk
On Error Resume Next

Dim pp As Integer
For pp = 9 To 215
Controls("TextBox" & pp).Value = ""
Next pp
MsgBox ("Kayıt bulunamadı.")
Exit Sub
ekrann:
On Error Resume Next


Dim mm As Integer
For mm = 9 To 215
Controls("TextBox" & mm).Text = ActiveCell.Offset(0, mm - 9).Text
Next mm
TextBox41 = Replace(TextBox41, ",", ".")
TextBox42 = Replace(TextBox42, ",", ".")
TextBox43 = Replace(TextBox43, ",", ".")
TextBox44 = Replace(TextBox44, ",", ".")
TextBox45 = Replace(TextBox45, ",", ".")
TextBox46 = Replace(TextBox46, ",", ".")

TextBox216.Value = 1
MsgBox ("Dosya bulundu.")

Exit Sub

End If


End Sub
 
C

class37

Katılım
17 Ağustos 2004
Mesajlar
222
Excel Vers. ve Dili
Ofiste Excel 2000 Türkçe
Evde Excel 2003 Türkçe
Merhaba
O kodlarda değişik nesneler ve sorgular var daha doğrusu değişik amaç için yapılmış kodlar.Benim yazdığı kodlarla sayfaya kayıt yapabilirsiniz.Dahada olmazsa dosyanızı ekleyin.İyiçalışmalar.
 
burhancavus61

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
ekliyorum hocam

dosyayı ekliyorum hocam eğer neye göre kayıt yaptığını anlarsam DTPicker kullanarak tarih kısımlarını değiştirmek istiyordum
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst