Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Haziran 2008 Salı

Data Base Management on UserForm





'UserForm1

Option Explicit
Dim SBKontrol As Double
Dim i, No, ÖncekiNo, Adet As Integer
Dim Bakılan, Alan As Range
Dim Adres As String

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Data Base Management on UserForm..."
ÖncekiNo = 0
No = 1
Adet = Application.WorksheetFunction.CountA(Range("B2:B65000"))
If Adet > 0 Then
With SpinButton1
.SmallChange = 1
.Max = Adet
.Min = 1
.Value = 1
End With
Else
With SpinButton1
.SmallChange = 1
.Max = 0
.Min = 0
.Value = 0
End With
End If
Sheets("Veri").Select
TextBox1.Locked = True
ComboBox1.RowSource = "Veri!B2:B65536"
End Sub
Private Sub SpinButton1_Change()
On Error Resume Next
If SBKontrol = 0 Then
Adet = Application.WorksheetFunction.Count(Range("A2:A65000"))
Adres = "A2:D" & (Adet + 1)
No = SpinButton1.Value
Call VeriGönder
Call VeriGetir
ÖncekiNo = No
Range(Cells((No + 1), 1), Cells((No + 1), 4)).Select
End If
End Sub
Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 2) = TextBox2.Text
End Sub
Private Sub TextBox3_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 3) = TextBox3.Text
End Sub
Private Sub TextBox4_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 4) = TextBox4.Text
End Sub
Private Sub ComboBox1_Click()
On Error Resume Next
If Adet > 0 Then
No = VeriTarama(ComboBox1.Value, 2)
Call VeriGönder
Call VeriGetir
ÖncekiNo = No
Range(Cells((No + 1), 1), Cells((No + 1), 4)).Select
End If
End Sub
Private Sub CommandButton1_Click() 'Kayıt Ekle
On Error Resume Next
SBKontrol = 1
If Adet > 0 Then
Selection.EntireRow.Insert
Adet = Adet + 1
For i = 1 To Adet
Cells((i + 1), 1) = i
Next i
With SpinButton1
.Min = 1
.Max = Adet
End With
ÖncekiNo = ÖncekiNo + 1
Adres = "A2:D" & Application.WorksheetFunction.Count(Range("A2:A65000")) + 1
Call VeriGönder
Call VeriGetir
ÖncekiNo = ÖncekiNo - 1
Else
Adet = Adet + 1
Cells(2, 1) = 1
With SpinButton1
.Min = 1
.Max = 1
.Value = 1
End With
No = 1
ÖncekiNo = 1
Adres = "A2:D2"
Call VeriGetir
Range(Cells((No + 1), 1), Cells((No + 1), 4)).Select
End If
SBKontrol = 0
End Sub
Private Sub CommandButton2_Click() 'Kayıt Sil
On Error Resume Next
SBKontrol = 1
If Adet > 0 Then
Selection.EntireRow.Delete
Adet = Adet - 1
If Adet > 0 Then
With SpinButton1
.Min = 1
.Max = Adet
End With
For i = 1 To Adet
Cells((i + 1), 1) = i
Next i
Call VeriGetir
Else
With SpinButton1
.Min = 0
.Max = 0
End With
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
End If
End If
SBKontrol = 0
End Sub
Private Function VeriTarama(ByVal Taranan As Variant, ByVal Sütun As Double)
On Error Resume Next
i = 0
If Sütun = 2 Then
For Each Bakılan In Range("B2:B" & Application.WorksheetFunction.CountA(Range("B2:B65536")))
i = i + 1
If Bakılan.Value = Taranan Then
VeriTarama = i
Exit Function
End If
Next Bakılan
Else
End If
End Function
Sub VeriGönder()
On Error Resume Next
If ÖncekiNo > 0 Then
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 1) = TextBox1.Text
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 2) = TextBox2.Text
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 3) = TextBox3.Text
Sheets("Veri").Range(Adres).Cells(ÖncekiNo, 4) = TextBox4.Text
End If
End Sub
Sub VeriGetir()
On Error Resume Next
If No > 0 Then
TextBox1.Text = Sheets("Veri").Range(Adres).Cells(No, 1)
TextBox2.Text = Sheets("Veri").Range(Adres).Cells(No, 2)
TextBox3.Text = Sheets("Veri").Range(Adres).Cells(No, 3)
TextBox4.Text = Sheets("Veri").Range(Adres).Cells(No, 4)
End If
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul