this is the coding of form grouping
'variable declaration
Dim Edit As Boolean
Dim RsGroup As New ADODB.Recordset
Dim Edit As Boolean
Dim RsGroup As New ADODB.Recordset
Private Sub Command1_Click()
FrmCariGroup.Show 1
MsgBox FrmCariGroup.Kodex
MsgBox FrmCariGroup.Namax
End Sub
FrmCariGroup.Show 1
MsgBox FrmCariGroup.Kodex
MsgBox FrmCariGroup.Namax
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'form shortcut button
Select Case KeyCode
' press F2 call procedure to create new data
Case vbKeyF2:
KeyCode = 0
Baru
' press F3 call procedure to save data to database
Case vbKeyF3:
KeyCode = 0
simpan
' press F5 call procedure to cancel the current operatiohhhhhhHHhhhhHHHHn
Case vbKeyF5:
KeyCode = 0
batal
' press F6 call procedure to delete data on database
Case vbKeyF4:
KeyCode = 0
Hapus
' press ESC to unload form
Case vbKeyEscape:
KeyCode = 0
Unload Me
End Select
End Sub
'form shortcut button
Select Case KeyCode
' press F2 call procedure to create new data
Case vbKeyF2:
KeyCode = 0
Baru
' press F3 call procedure to save data to database
Case vbKeyF3:
KeyCode = 0
simpan
' press F5 call procedure to cancel the current operatiohhhhhhHHhhhhHHHHn
Case vbKeyF5:
KeyCode = 0
batal
' press F6 call procedure to delete data on database
Case vbKeyF4:
KeyCode = 0
Hapus
' press ESC to unload form
Case vbKeyEscape:
KeyCode = 0
Unload Me
End Select
End Sub
Sub simpan()
' procedure of saving data
If Trim(TxtNama) = "" Then
'if textbox txtnama empty then show alert
MsgBox "Nama group masih kosong."
TxtNama.SetFocus
Exit Sub
End If
' procedure of saving data
If Trim(TxtNama) = "" Then
'if textbox txtnama empty then show alert
MsgBox "Nama group masih kosong."
TxtNama.SetFocus
Exit Sub
End If
If Edit Then
' if editing data
SQL = "update ItemGroup set GroupName='" & Trim(TxtNama) & "' where GroupCode='" & Trim(TxtKode) & "'"
Else
'if not editing data
SQL = "insert into itemgroup(GroupCode,GroupName,GroupCreated,Status,Transfered) values ('" & Trim(KodeAuto) & _
"','" & Trim(TxtNama) & "'," & LocalToStamp(Date) & ",'I','N')"
End If
' if editing data
SQL = "update ItemGroup set GroupName='" & Trim(TxtNama) & "' where GroupCode='" & Trim(TxtKode) & "'"
Else
'if not editing data
SQL = "insert into itemgroup(GroupCode,GroupName,GroupCreated,Status,Transfered) values ('" & Trim(KodeAuto) & _
"','" & Trim(TxtNama) & "'," & LocalToStamp(Date) & ",'I','N')"
End If
' open database connection
If buka Then
' executing sql query
DbCon.Execute (SQL)
' closing database connection
DbCon.Close
' call procedure refreshdata
RefreshData
' message box
frmMsgBox.Msg "Data tersimpan.", mbOKOnly
End If
If buka Then
' executing sql query
DbCon.Execute (SQL)
' closing database connection
DbCon.Close
' call procedure refreshdata
RefreshData
' message box
frmMsgBox.Msg "Data tersimpan.", mbOKOnly
End If
batal
End Sub
End Sub
Private Sub TxtCari_Change()
If Edit And Trim(TxtCari) <> "" Then
RsGroup.Find "GroupName like '%" & TxtCari & "%'", , adSearchForward, 1
If Not RsGroup.EOF Then
TxtKode = RsGroup!GroupCode
TxtNama = RsGroup!GroupName
Else
TxtNama = ""
TxtKode = ""
End If
End If
End Sub
If Edit And Trim(TxtCari) <> "" Then
RsGroup.Find "GroupName like '%" & TxtCari & "%'", , adSearchForward, 1
If Not RsGroup.EOF Then
TxtKode = RsGroup!GroupCode
TxtNama = RsGroup!GroupName
Else
TxtNama = ""
TxtKode = ""
End If
End If
End Sub
Sub Hapus()
If frmMsgBox.Msg("Hapus " & Trim(Grid.Columns(0).Text) & "?", mbYesNo, "", mbQuestion) = 1 Then
' if messagebox return yes then deleting record
' quering sql
SQL = "delete from ItemGroup where GroupCode='" & Trim(Grid.Columns(0).Text) & "'"
DbCon.Execute SQL
' show alert
frmMsgBox.Msg "Data terhapus.", mbOKOnly
' get data from database
' open database connection
If buka Then
' executing sql query
DbCon.Execute (SQL)
' closing database connection
DbCon.Close
' call procedure refreshdata
RefreshData
' message box
frmMsgBox.Msg "Data terhapus.", mbOKOnly
End If
If frmMsgBox.Msg("Hapus " & Trim(Grid.Columns(0).Text) & "?", mbYesNo, "", mbQuestion) = 1 Then
' if messagebox return yes then deleting record
' quering sql
SQL = "delete from ItemGroup where GroupCode='" & Trim(Grid.Columns(0).Text) & "'"
DbCon.Execute SQL
' show alert
frmMsgBox.Msg "Data terhapus.", mbOKOnly
' get data from database
' open database connection
If buka Then
' executing sql query
DbCon.Execute (SQL)
' closing database connection
DbCon.Close
' call procedure refreshdata
RefreshData
' message box
frmMsgBox.Msg "Data terhapus.", mbOKOnly
End If
End If
End Sub
End Sub
Sub batal()
' procedure to cancel current operation
' clear all fields
Bersih
' get data from database
RefreshData
End Sub
' procedure to cancel current operation
' clear all fields
Bersih
' get data from database
RefreshData
End Sub
Sub Baru()
' procedure to create new data
' clear all fields
Bersih
' fill txtkode with generate code
TxtKode = KodeAuto
TxtNama.SetFocus
Edit = False
End Sub
' procedure to create new data
' clear all fields
Bersih
' fill txtkode with generate code
TxtKode = KodeAuto
TxtNama.SetFocus
Edit = False
End Sub
Sub Bersih()
' clear all fields
TxtKode = ""
TxtNama = ""
End Sub
' clear all fields
TxtKode = ""
TxtNama = ""
End Sub
Private Sub Form_Load()
' when form loading to memory
' organize the form
Me.Height = Me.BasForm1.Height
Me.Width = Me.BasForm1.Width
' when form loading to memory
' organize the form
Me.Height = Me.BasForm1.Height
Me.Width = Me.BasForm1.Width
GetLocation Me
ResizeForm Me
CenterForm Me
ResizeForm Me
CenterForm Me
' built connection to database
If DbCon.State Then DbCon.Close
If DbCon.State Then DbCon.Close
' create a recordset for data
With RsGroup
.Fields.Append "GroupCode", adVarChar, 10
.Fields.Append "GroupName", adVarChar, 50
.Open
End With
With RsGroup
.Fields.Append "GroupCode", adVarChar, 10
.Fields.Append "GroupName", adVarChar, 50
.Open
End With
' get data from database
RefreshData
' editing data is false
Edit = True
End Sub
RefreshData
' editing data is false
Edit = True
End Sub
Sub DropRs()
' delete data on recordset
If RsGroup.RecordCount > 0 Then
' if recordcount in recordset more then 0 then
' delete all data on recordset with looping method
RsGroup.MoveFirst
While Not RsGroup.EOF
RsGroup.Delete
RsGroup.MoveNext
Wend
End If
End Sub
' delete data on recordset
If RsGroup.RecordCount > 0 Then
' if recordcount in recordset more then 0 then
' delete all data on recordset with looping method
RsGroup.MoveFirst
While Not RsGroup.EOF
RsGroup.Delete
RsGroup.MoveNext
Wend
End If
End Sub
Sub RefreshData()
' procedure to get data from database
' procedure to get data from database
' clear data on recordset
DropRs
DropRs
SQL = "select groupcode,groupname from itemgroup order by GroupCode"
' set recordset to get query result
' set recordset to get query result
If buka Then
' open connection to database
Set RSFind = DbCon.Execute(SQL)
' tranfer data from database to recordset
If Not RSFind.BOF Then
RSFind.MoveFirst
While Not RSFind.EOF
RsGroup.AddNew
RsGroup!GroupCode = RSFind!GroupCode
RsGroup!GroupName = RSFind!GroupName
RSFind.MoveNext
Wend
' set grid's datasource to the recordset
Grid.DataSource = RsGroup
RsGroup.MoveFirst
Edit = True
End If
DbCon.Close
End If
' open connection to database
Set RSFind = DbCon.Execute(SQL)
' tranfer data from database to recordset
If Not RSFind.BOF Then
RSFind.MoveFirst
While Not RSFind.EOF
RsGroup.AddNew
RsGroup!GroupCode = RSFind!GroupCode
RsGroup!GroupName = RSFind!GroupName
RSFind.MoveNext
Wend
' set grid's datasource to the recordset
Grid.DataSource = RsGroup
RsGroup.MoveFirst
Edit = True
End If
DbCon.Close
End If
TxtCari = ""
End Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
If frmMsgBox.Msg("Keluar program?", mbYesNo, , mbQuestion) = 1 Then
If RsGroup.State Then RsGroup.Close
Cancel = 0
Else
Cancel = 1
End If
End Sub
If frmMsgBox.Msg("Keluar program?", mbYesNo, , mbQuestion) = 1 Then
If RsGroup.State Then RsGroup.Close
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
' change data when the cursor moving on grid
TxtKode = Trim(Grid.Columns(0).Text)
TxtNama = Trim(Grid.Columns(1).Text)
End Sub
' change data when the cursor moving on grid
TxtKode = Trim(Grid.Columns(0).Text)
TxtNama = Trim(Grid.Columns(1).Text)
End Sub
Private Sub TxtCari_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub TxtKode_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub TxtNama_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Function KodeAuto()
' procedure to generate code
' select data where filter by GroupCode from last to first
SQL = "Select GroupCode from ItemGroup order by GroupCode Desc"
' procedure to generate code
' select data where filter by GroupCode from last to first
SQL = "Select GroupCode from ItemGroup order by GroupCode Desc"
If buka Then
Set RSFind = DbCon.Execute(SQL)
If RSFind.BOF Then
' when data is empty return this code
KodeAuto = "GRP-" & "00001"
Else
' when data is not empty return this auto increasement code
KodeAuto = "GRP-" & Format(CInt(Right(RSFind!GroupCode, 4)) + 1, "00000")
End If
DbCon.Close
End If
End Function
Set RSFind = DbCon.Execute(SQL)
If RSFind.BOF Then
' when data is empty return this code
KodeAuto = "GRP-" & "00001"
Else
' when data is not empty return this auto increasement code
KodeAuto = "GRP-" & Format(CInt(Right(RSFind!GroupCode, 4)) + 1, "00000")
End If
DbCon.Close
End If
End Function
No comments:
Post a Comment