Açıklama alanı oluşturma

[mustafa155]

değerli arkadaşlar ve sevgili hocalarım. konu ile ilgili sorunun açıklaması ekli dosya içerisindedir.
Saygılarımla

 

[mehmett]

Forum kuralları;

12 - Örnek dosya eklediğinizde ise sorunuzu dosya içine değil (isterseniz orayada yazın) ama foruma yazmanızda fayda var. Hiçbir ipucu olmayan bir dosyayı indirmektense hiç indirmemeyi tercih edebilirsiniz sizde.

 

[mustafa155]

Forum kuralları;

12 - Örnek dosya eklediğinizde ise sorunuzu dosya içine değil (isterseniz orayada yazın) ama foruma yazmanızda fayda var. Hiçbir ipucu olmayan bir dosyayı indirmektense hiç indirmemeyi tercih edebilirsiniz sizde.

Soru şu;
bir formda kayıt edilen her şahıs ile ilgili açıklama ekleyebilme. Yani şahıs ile ilgli form oluşturulduğunda belirlenen bir alanda (userform üzerinde olabilir veya uygun görülen başka bir alanda) açıklamalar eklemeyi mümkün kılınmasını istiyorum.

 

[ileriexcel]

kodlar oluşturulan açıklama sayfasına endekslenmiştir.
Sayfa gizlenebilir.

'kayıt
Private Sub CommandButton1_Click()
Dim sira, say As Integer
Set a = Sheets("açıklama")
a.Range("a1") = "sıra no"
a.Range("b1") = "isimler"
a.Range("c1") = "açıklamalar"
For sira = 1 To WorksheetFunction.CountA(a.Range("b1:b65000"))
a.Range("a" & sira + 1) = sira
Next
say = WorksheetFunction.CountA(a.Range("b1:b65000"))
a.Range("b" & say + 1) = TextBox1
a.Range("c" & say + 1) = TextBox2
TextBox1 = Empty
TextBox2 = Empty
End Sub
'bul
Private Sub CommandButton2_Click()
Dim bul As Range
Set a = Sheets("açıklama")
For Each bul In a.Range("b1:b" & WorksheetFunction.CountA(a.Range("b1:b65000")))
If StrConv(bul, vbUpperCase) = StrConv(TextBox1, vbUpperCase) Then
a.Activate
bul.Select
TextBox1 = ActiveCell.Offset(0, 0).Value
TextBox2 = ActiveCell.Offset(0, 1).Value
MsgBox "veriniz bulundu"
Exit Sub
End If
Next
MsgBox "veriniz bulunamadı"
End Sub
'değiştir
Private Sub CommandButton3_Click()
Set a = Sheets("açıklama")
a.Activate
If TextBox1 = Empty Then
MsgBox "önce bulunacak veriyi girmelisiniz"
Exit Sub
End If
ActiveCell.Offset(0, 1) = TextBox1.Value
ActiveCell.Offset(0, 1) = TextBox2.Value
TextBox1 = Empty
TextBox2 = Empty
MsgBox "verileriniz değiştirilmiştir"
End Sub
'sil
Private Sub CommandButton4_Click()
Set a = Sheets("açıklama")
a.Activate
If TextBox1 = Empty Then
MsgBox "önce silinecek veriyi bulmalısınız"
Exit Sub
End If
Range(ActiveCell.Offset(0, -1).Address(False, False), ActiveCell.Offset(0, 3).Address(False, False)).Delete shift:=xlUp
TextBox1 = Empty
TextBox2 = Empty
MsgBox "verileriniz silinmiştir"
End Sub