-
March 12th, 2014, 11:16 AM
#1
Error in Count of records
Code:
Option Explicit
Dim tr_no As String
Private rs As New ADODB.Recordset
Private ForeColors(0 To 2, 0 To 1) As Long
Private BackColors(0 To 2, 0 To 1) As Long
Private Sub Form_load()
Combo3.AddItem "1"
Combo3.AddItem "2"
Combo3.AddItem "3"
Combo3.AddItem "4"
Combo3.AddItem "5"
Combo3.AddItem "6"
Combo3.AddItem "7"
Combo3.AddItem "8"
Combo3.AddItem "9"
Combo3.AddItem "10"
Combo3.AddItem "11"
Combo3.AddItem "12"
Combo3.AddItem "13"
Combo3.AddItem "14"
Combo3.AddItem "15"
Combo3.AddItem "16"
Combo3.AddItem "17"
Combo3.AddItem "18"
Combo3.AddItem "19"
Combo3.AddItem "20 "
ForeColors(1, 0) = vbBlue
ForeColors(1, 1) = BackColor
BackColors(1, 0) = BackColor
BackColors(1, 1) = BackColor
tmrBlink_Timer
tmrBlink.Interval = 500
tmrBlink.Enabled = True
End Sub
Private Sub cmdNew_Click()
tr_no = autogen
frmCommission_Entry.txtSeno = tr_no
frmCommission_Entry.txtEdate = Date
txtShaha.SetFocus
End Sub
Private Sub cmdSave_Click()
Dim cnuser As New ADODB.connection
Dim rsuser As New ADODB.Recordset
If sempty(txtFulNa.Text) = True Then Exit Sub
If sempty(txtFan.Text) = True Then Exit Sub
If sempty(txtEdate.Text) = True Then Exit Sub
If sempty(txtShaha.Text) = True Then Exit Sub
If sempty(txtSeno.Text) = True Then Exit Sub
If sempty(txtFisNa.Text) = True Then Exit Sub
If sempty(txtSecNa.Text) = True Then Exit Sub
If sempty(txtLasNa.Text) = True Then Exit Sub
If sempty(txt1stID.Text) = True Then Exit Sub
If sempty(txtExpDate.Text) = True Then Exit Sub
If sempty(txtMob.Text) = True Then Exit Sub
If sempty(txtChq.Text) = True Then Exit Sub
If sempty(txtBank.Text) = True Then Exit Sub
If sempty(Combo3.Text) = True Then Exit Sub
If sempty(txtPrn.Text) = True Then Exit Sub
Call connection(cnuser, App.Path & "\Commissions.mdb", "endromida")
'Call connection(cnuser, "\\mika\medrar\Commissions.mdb", "endromida")
Call Recordset(rsuser, cnuser, "SELECT * FROM commi_cus")
With rsuser
.AddNew
Call shasta
.Fields!funa = txtFulNa.Text
.Fields!Sha_no = txtShaha.Text
.Fields!Edate = txtEdate.Text
.Fields!tr_no = txtSeno.Text
.Fields!fami_na = txtFan.Text
.Fields!first_na = txtFisNa.Text
.Fields!sec_na = txtSecNa.Text
.Fields!last_na = txtLasNa.Text
.Fields!cus_id = txt1stID.Text
.Fields!cus_mo = txtMob.Text
.Fields!exp_date = txtExpDate.Text
.Fields!cus_mo = txtMob.Text
.Fields!ch_no = txtChq.Text
.Fields!ba = txtBank.Text
.Fields!tran_co = Combo3.Text
.Fields!pro_na = txtPrn.Text
.Update
End With
MsgBox "Successfully Saved.", vbInformation
Call cmdRePrint_Click
Call clear
Set cnuser = Nothing
Set rsuser = Nothing
End Sub
Private Sub lvButtons_H2_Click()
Unload Me
End Sub
Function autogen() As String
Dim cnview As New ADODB.connection
Dim rsview As New ADODB.Recordset
Call connection(cnview, App.Path & "\Commissions.mdb", "endromida")
Call Recordset(rsview, cnview, "SELECT max(tr_no)FROM Commi_Cus")
If IsNull(rsview(0)) = True Then
autogen = "T-0000"
Else
autogen = "T-" & Format(Right$(Trim$(rsview(0)), 4) + 1, "0000")
End If
End Function
Public Sub clear()
txtSeno.Text = ""
txtShaha.Text = ""
txtEdate = Format(Date, "dd-mm-yyyy")
txtFan.Text = ""
txtFisNa.Text = ""
txtSecNa.Text = ""
txtLasNa.Text = ""
txt1stID.Text = ""
txtExpDate = Format(Date, "dd-mm-yyyy")
txtChq.Text = ""
txtBank.Text = ""
txtMob.Text = ""
txtFulNa.Text = ""
txtPrn.Text = ""
End Sub
Private Sub lvButtons_H5_Click()
Call cmdRePrint_Click
End Sub
Private Sub txtPrn_Change()
IntelliSense txtPrn, "commi_cus", "pro_na"
End Sub
Private Sub txtshaha_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtPrn.SetFocus
End If
End Sub
Private Sub txtprn_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo3.SetFocus
End If
End Sub
Private Sub combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txt1stID.SetFocus
End If
End Sub
Private Sub txt1stid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtChq.SetFocus
End If
End Sub
Private Sub txtchq_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtBank.SetFocus
End If
End Sub
Private Sub txtbank_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdSave.SetFocus
End If
End Sub
Private Sub cmdRePrint_Click()
Call ConnectMe
Set rs = New ADODB.Recordset
rs.Open "select * from commi_cus where tr_no = '" & txtSeno.Text & "'", con, 1, 3
If rs.RecordCount = 0 Then
MsgBox "No Record Found On Query.", vbCritical, "Medrar"
Else
'Set Sales_Agreement.DataSource = rs
Set DataReport1.DataSource = rs
Unload Me
'ChngPrinterOrientationPortrait Me
'Sales_Agreement.Show
DataReport1.Show
End If
Set rs = Nothing
End Sub
Private Sub txtshaha_Change()
IntelliSense txtShaha, "Commi_Cus", "sha_no"
Call pre
End Sub
Private Sub tmrBlink_Timer()
Static State As Integer
Dim fore_color As Long
Dim i As Integer
' Toggle the state.
State = 1 - State
' Set the colors.
For i = 1 To 1
' lblBlink(i).ForeColor = ForeColors(i, State)
Next i
End Sub
Function Cant()
Dim cnview As New ADODB.connection
Dim rsview As New ADODB.Recordset
Call connection(cnview, App.Path & "\Commissions.mdb", "endromida")
Call Recordset(rsview, cnview, "SELECT COUNT(*) AS numRecords FROM Commi_Cus")
txtShaha = .Fields!Sha_no
txtCou.Text = rec("numRecords").Value
End If
End Function
Private Sub cus()
Dim cnview As New ADODB.connection
Dim rsemployee As New ADODB.Recordset
Call connection(cnview, App.Path & "\Commissions.mdb", "endromida")
Call Recordset(rsemployee, cnview, "SELECT * FROM customer WHERE idcn =" & txt1stID.Text & "")
If rsemployee.RecordCount = 0 Then
MsgBox "The record you requested could not be found.", vbExclamation, "Medrar"
Exit Sub
End If
With rsemployee
txtFan.Text = .Fields!fname
txtFisNa.Text = .Fields!fsna
txtSecNa.Text = .Fields!sena
txtLasNa.Text = .Fields!trna
txtFulNa.Text = .Fields!funame
txtMob.Text = .Fields!mobie
txtExpDate.Text = .Fields!exd
End With
Set cnview = Nothing
Set rsemployee = Nothing
End Sub
Private Sub txt1stid_Change()
IntelliSense txt1stID, "customer", "idcn"
Call cus
End Sub
Private Sub pre()
Dim cnview As New ADODB.connection
Dim rsemployee As New ADODB.Recordset
Call connection(cnview, App.Path & "\Commissions.mdb", "endromida")
Call Recordset(rsemployee, cnview, "SELECT * FROM commi_cus WHERE sha_no =" & txtShaha.Text & "")
If recexist("commi_cus", "sha_no", txtShaha.Text, cnview) = True Then Call hlfocus(txtPrt): Exit Sub
With rsemployee
txtPrt.Text = .Fields!funa
End With
End Sub
Function shasta()
Dim cnview As New ADODB.connection
Dim rsview As New ADODB.Recordset
Call connection(cnview, App.Path & "\Commissions.mdb", "endromida")
Call Recordset(rsview, cnview, "SELECT * FROM Commi_Cus")
If recexist("commi_cus", "sha_no", txtShaha.Text, cnview) = False Then
Call st
Else
Call stay
End If
End
End Function
Private Sub st()
txtstat.Text = " Present"
End Sub
Private Sub stay()
txtstat.Text = " Transfred"
End Sub
Errors in Pre() and Function Cant()
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|