Antalet af forespørgselsværdier od destionsfelter er ikke det sam
X jeg fundt en go program på http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=62502&lngWId=1Den gode men men jeg vil her at den gemer i databasen i danske kr.Og de vil den ikke den hvis jeg skriver 15,95 sår siger den at
Antalet af forespørgselsværdier od destionsfelter er ikke det samme
har prøvet med text5.text = Val(txtQTY.text) * Val(txtRate.text)
txtRate.text = Format$(txtRate.text, "#,##0.00")
12 timer har jeg prøvet men det for det sammen savar
Option Explicit
Dim SaleReg As Boolean
Dim SaleOrder As Boolean
Dim SaleRet As Boolean
Dim CustName As String
Dim CustID As String
Dim SalesID As String
Dim TXTLEN As Integer
Dim STRT As Integer
Dim PRILEN As Integer
Dim bLook As Boolean
Private Sub cmbCust_Click()
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * from Customer where company='" & cmbCust.text & "'")
If Rs1.RecordCount <> 0 Then
CustID = Rs1!customeriD
End If
If cmbCust.text <> "" Then
Text4.Enabled = True
Else
Text4.Enabled = False
End If
End Sub
Private Sub cmdAdd_Click()
Dim LSTITEM As ListItem
Dim CNT As Boolean
Dim DD As Integer
''' query in quantity is not yet included
txtQTY.text = Val(txtQTY.text)
If text5.text <> "" Then
CNT = False
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * from Product where ProductID like'" & Text4 & "%' OR Name like'" & Text4 & "%'")
If Not Rs1.EOF Then
'LBL_DES.Caption = RS1!ProductID & ", " & RS1!Name & ""
txtRate = Rs1!UnitSellingPrice
With lvMain
TextAmount.text = ""
If .ListItems.Count <> 0 Then
For DD = 1 To .ListItems.Count
If InStr(1, .ListItems(DD).text, Rs1!ProductID) = 1 Then
If InStr(1, .ListItems(DD).SubItems(1), Rs1!Name) = 1 Then
' If StrComp(.ListItems(DD).text, RS1!ProductID) = 1 Then
If EDT = True Then
.ListItems(DD).Selected = True
.ListItems(DD).SubItems(2) = Val(txtQTY.text)
.ListItems(DD).SubItems(3) = Val(txtRate.text)
.ListItems(DD).SubItems(4) = text5.text
Else
.ListItems(DD).Selected = True
.ListItems(DD).SubItems(2) = Val(.ListItems(DD).SubItems(2)) + Val(txtQTY.text)
.ListItems(DD).SubItems(3) = Val(txtRate.text)
.ListItems(DD).SubItems(4) = Val(.ListItems(DD).SubItems(2)) * Val(.ListItems(DD).SubItems(3))
End If
CNT = True
End If
End If
Next
End If
If CNT = False Then
.ListItems.Add , , Rs1!ProductID
.ListItems(.ListItems.Count).SubItems(1) = Rs1!Name
.ListItems(.ListItems.Count).SubItems(2) = txtQTY.text
.ListItems(.ListItems.Count).SubItems(3) = txtRate.text
.ListItems(.ListItems.Count).SubItems(4) = text5.text
' TextAmount.Text = Val(TextAmount.Text) + Val(TXT_AMT.Text)
End If
If .ListItems.Count <= 0 Then
.ListItems.Add 1, , Rs1!ProductID
.ListItems(.ListItems.Count).SubItems(1) = Rs1!Name
.ListItems(.ListItems.Count).SubItems(2) = txtQTY.text
.ListItems(.ListItems.Count).SubItems(3) = txtRate.text
.ListItems(.ListItems.Count).SubItems(4) = text5.text
End If
For DD = 1 To .ListItems.Count
TextAmount.text = Val(.ListItems(DD).SubItems(4)) + Val(TextAmount.text)
Next
' lblunit.Caption = RS1!UnitsInStock
Set Rs1 = DCON.Execute("Select * from Product")
' Set DataGrid1.DataSource = RS1
Set Rs1 = Nothing
Set DCON = Nothing
End With
Else
MsgBox "Product Not Found", vbInformation, "Product"
End If
Text4.text = ""
text5.text = ""
txtQTY.text = ""
txtRate.text = ""
EDT = False
'Text4.SetFocus
Else
txtQTY.SetFocus
End If
End Sub
Private Sub cmdAdd_GotFocus()
If Text4.text <> "" Then
Call GetNewConnection2
Set Rs1 = New Recordset
SQL = "Select TOP 5 * from PRODUCT where PRODUCTID='" & Text4 & "' OR NAME='" & Text4 & "'"
Set Rs1 = DCON.Execute(SQL)
SQL = "Select * from Product where (PRODUCTID='" & Rs1!ProductID & "' AND UnitCostPrice <" & Val(txtRate.text) & ")"
Set Rs1 = DCON.Execute(SQL)
If Rs1.RecordCount <> 0 Then
SQL = "UPDATE PRODUCT set UnitSellingPrice=" & Val(txtRate.text) & " where (PRODUCTID='" & Rs1!ProductID & "' AND UnitCostPrice <" & Val(txtRate.text) & ")"
DCON.Execute SQL
Else
SQL = "Select TOP 5 * from PRODUCT where PRODUCTID='" & Text4 & "' OR NAME='" & Text4 & "'"
Set Rs1 = DCON.Execute(SQL)
If Rs1!UnitSellingPrice <> txtRate.text Then
MsgBox "Cannot Update UnitSellingPrice" & vbTab, vbInformation
txtRate.SetFocus
End If
If Rs1.RecordCount <> 0 Then
txtRate.text = Rs1!UnitSellingPrice
End If
End If
Set Rs1 = Nothing
Set DCON = Nothing
End If
End Sub
Private Sub cmdClear_Click()
EDT = False
lvMain.ListItems.clear
picTop.Enabled = False
cmbCust.Enabled = False
lvLook.Enabled = False
lvMain.Enabled = False
Text4.text = ""
text5.text = ""
txtQTY.text = ""
txtRate.text = ""
'Text4.SetFocus
cmdOk.Enabled = False
cmdClear.Enabled = False
Command1.Enabled = True
TXTNUM.text = ""
cmbCust.ListIndex = -1
End Sub
Private Sub cmdOk_Click()
If lvMain.ListItems.Count > 0 Then
cmdClear.Enabled = False
cmdOk.Enabled = False
Command1.Enabled = True
picTop.Enabled = False
lvLook.Enabled = False
lvMain.Enabled = False
cmbCust.Enabled = False
Call SalesReg
MsgBox "Record has been Saved", vbInformation
Else
MsgBox "There is no Product to record", vbInformation
End If
End Sub
Private Sub Command1_Click()
Dim CDb As CDbase
Dim CIns As New CInsert
'Dim SalesID As String
Dim CNT1 As Integer
Call GetNewConnection(CIns)
Set CDb = CIns
SalesID = CIns.AUTONUM(CDb.OpenDb, "SalesRegistryHeader", "SalesRegistryID", "SR", TXTNUM)
Set CIns = Nothing
cmbCust.Enabled = True
cmdClear.Enabled = True
cmdOk.Enabled = True
Command1.Enabled = False
picTop.Enabled = True
lvLook.Enabled = True
lvMain.Enabled = True
lvMain.ListItems.clear
Text4.text = ""
text5.text = ""
txtQTY.text = ""
txtRate.text = ""
End Sub
Private Sub Form_Load()
Timer2.Enabled = True
Timer2.Interval = 100
SaleReg = False
SaleRet = False
SaleOrder = False
bLook = False
' cmbCust.AddItem "Cash"
' cmbCust.ListIndex = 0
Call CMB1("Customer", "Company", cmbCust)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'frmMAIN.WindowState = 0
End Sub
Private Sub LvHeads()
lvMain.ColumnHeaders(1).Width = lvMain.Width * 0.1
lvMain.ColumnHeaders(2).Width = lvMain.Width * 0.2
lvMain.ColumnHeaders(3).Width = lvMain.Width * 0.2
End Sub
Private Sub SalesReg()
Dim CNT1 As Integer
With lvMain
If .ListItems.Count > 0 Then
Call GetNewConnection2
' If CRED = True Then
If cmbCust.text <> "Cash" Then
'SalesRegistryHeader
'SalesRegistryDetail
SQL = "Insert into SalesRegistryHeader values('" & SalesID & "','" _
& CustID & "'," _
& 1 & ",'" & CStr(DTPicker4.Value) & "')"
' CRED = False
DCON.Execute SQL
Else
SQL = "Insert into SalesRegistryHeader values('" & SalesID & "','" _
& "Cash" & "'," _
& 1 & ",'" & CStr(DTPicker4.Value) & "')"
DCON.Execute SQL
End If
For CNT1 = 1 To .ListItems.Count
SQL = "Insert into SalesRegistryDetail values('" & SalesID & "','" _
& .ListItems(CNT1).text & "'," & .ListItems(CNT1).SubItems(2) & "," & .ListItems(CNT1).SubItems(3) & ")"
DCON.Execute SQL
Set Rs1 = New Recordset
SQL = "Select * from Product where productid='" & .ListItems(CNT1).text & "'"
Set Rs1 = DCON.Execute(SQL)
SQL = "update Product set UnitsInStock=" & Val(Val(Rs1!UnitsInStock) - Val(.ListItems(CNT1).SubItems(2))) _
& " WHERE ProductID='" & .ListItems(CNT1).text & "'"
DCON.Execute SQL
Next
Set Rs1 = Nothing
Set DCON = Nothing
End If
End With
End Sub
Private Sub lvLook_DblClick()
'Dim LVindex As Integer
'
'Dim LSTITEM As ListItem
'
'
'
'Dim CNT As Boolean
'Dim DD As Integer
'
'''' query in quantity is not yet included
'
'
' CNT = False
'
'
' Call GetNewConnection2
' Set Rs1 = New Recordset
' Set Rs1 = DCON.Execute("Select * from Product where ProductID='" & lvLook.SelectedItem.text & "'")
'
'If Not Rs1.EOF Then
'
' If Rs1!UnitsInStock > 0 Then
'
' 'LBL_DES.Caption = RS1!ProductID & ", " & RS1!Name & ""
' txtRate = Rs1!UnitSellingPrice
'
' With lvMain
' TextAmount.text = ""
'
' If .ListItems.Count <> 0 Then
'
' For DD = 1 To .ListItems.Count
'
' If InStr(1, .ListItems(DD).text, Rs1!ProductID) = 1 Then
' If InStr(1, .ListItems(DD).SubItems(1), Rs1!Name) = 1 Then
'
' If EDT = True Then
' .ListItems(DD).Selected = True
' .ListItems(DD).SubItems(2) = Val(txtQTY.text)
' .ListItems(DD).SubItems(3) = Val(txtRate.text)
' .ListItems(DD).SubItems(4) = text5.text
' Else
' .ListItems(DD).Selected = True
' .ListItems(DD).SubItems(2) = Val(.ListItems(DD).SubItems(2)) + 1
' .ListItems(DD).SubItems(3) = Val(txtRate.text)
' .ListItems(DD).SubItems(4) = Val(.ListItems(DD).SubItems(2)) * Val(.ListItems(DD).SubItems(3))
'
' End If
'
'
'
' CNT = True
'
' End If
'
'
'
' End If
'
' Next
'
' End If
'
' If CNT = False Then
'
'
' .ListItems.Add , , Rs1!ProductID
' .ListItems(.ListItems.Count).SubItems(1) = Rs1!Name
' .ListItems(.ListItems.Count).SubItems(2) = "1"
' .ListItems(.ListItems.Count).SubItems(3) = txtRate.text
' .ListItems(.ListItems.Count).SubItems(4) = text5.text
' txtQTY.text = "1"
'
'
'
' ' TextAmount.Text = Val(TextAmount.Text) + Val(TXT_AMT.Text)
'
' End If
'
'
'
'
'' If .ListItems.Count <= 0 Then
''
'' .ListItems.Add 1, , RS1!ProductID
'' .ListItems(.ListItems.Count).SubItems(1) = RS1!Name
'' .ListItems(.ListItems.Count).SubItems(2) = txtqty.text
'' .ListItems(.ListItems.Count).SubItems(3) = txtrate.text
'' .ListItems(.ListItems.Count).SubItems(4) = "1"
'' .ListItems(.ListItems.Count).SubItems(5) = Text5.text
''
''
'' End If
'
'
' For DD = 1 To .ListItems.Count
' TextAmount.text = Val(.ListItems(DD).SubItems(4)) + Val(TextAmount.text)
' Next
'
'
'
' Set Rs1 = Nothing
' Set DCON = Nothing
'
' End With
' Else
' MsgBox "This Product is out of Stock", vbInformation
'
'End If
'
'Else
' MsgBox "Product Not Found", vbInformation, "Product"
'
'
'End If
'
End Sub
Private Sub lvLook_ItemClick(ByVal Item As MSComctlLib.ListItem)
Timer2.Enabled = False
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * from product where productid='" & lvLook.SelectedItem.text & "'")
If Rs1!UnitsInStock > 0 Then
If Not Rs1.EOF Then
txtRate.text = Rs1!UnitSellingPrice
End If
If lvLook.ListItems.Count > 0 Then
Text4.text = lvLook.SelectedItem.text
End If
End If
End Sub
Private Sub lvLook_LostFocus()
Timer2.Enabled = True
End Sub
Private Sub lvLook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu mnuLook
End If
End Sub
Private Sub lvMain_Click()
EDT = True
If lvMain.ListItems.Count <> 0 Then
Text4.text = lvMain.ListItems(lvMain.SelectedItem.Index).text
txtQTY.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(2)
txtRate.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(3)
text5.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(4)
End If
End Sub
Private Sub lvMain_ItemClick(ByVal Item As MSComctlLib.ListItem)
EDT = True
If lvMain.ListItems.Count <> 0 Then
Text4.text = lvMain.ListItems(lvMain.SelectedItem.Index).text
txtQTY.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(2)
txtRate.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(3)
text5.text = lvMain.ListItems(lvMain.SelectedItem.Index).SubItems(4)
End If
End Sub
Private Sub lvMain_KeyDown(KeyCode As Integer, Shift As Integer)
Dim DD As Integer
With lvMain
If .ListItems.Count <> 0 Then
If KeyCode = vbKeyDelete Then
TextAmount.text = ""
.ListItems.Remove (.SelectedItem.Index)
Text4.text = ""
'lblcat.Caption = ""
EDT = False
txtRate.text = ""
text5.text = ""
txtQTY.text = ""
'lblselling.Caption = ""
'lblunit.Caption = ""
For DD = 1 To .ListItems.Count
TextAmount.text = Val(.ListItems(DD).SubItems(5)) + Val(TextAmount.text)
Next
End If
End If
End With
End Sub
Private Sub mnuUnit_Click()
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * from Product where ProductID='" & lvLook.SelectedItem.text & "'")
If Rs1.RecordCount <> 0 Then
MsgBox "Available Stock: " & Rs1!UnitsInStock
End If
Set Rs1 = Nothing
Set DCON = Nothing
End Sub
Private Sub Text4_Change()
'If EDT = False Then
Timer2.Interval = 100
TXTLEN = Len(Text4.text)
STRT = 0
'End If
'EDT = True
txtQTY.text = ""
If Len(Text4.text) <> 0 Then
txtQTY.Enabled = True
Else
txtQTY.Enabled = False
End If
End Sub
Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
Timer2.Interval = 0
End If
End Sub
Private Sub TextAmount_Change()
lblwords.Caption = NumToWord(TextAmount.text)
End Sub
Private Sub TextTend_Change()
TextChange.text = Val(TextTend.text) - Val(TextAmount.text)
End Sub
Private Sub TextTend_KeyPress(KeyAscii As Integer)
Call Decimals(KeyAscii, TextTend, 2)
End Sub
' Private Sub TextTend_KeyPress(KeyAscii As Integer)
' 'Call Decimals(KeyAscii, TextTend, 2)
'
' End Sub
Private Sub Timer2_Timer()
'Static c As Integer
STRT = STRT + 1
If STRT = 3 Then
Timer2.Interval = 0
Dim FVAL As String
Dim DD As Integer
Dim LISTITM As ListItem
'DataGrid1.Visible = True
Call GetNewConnection2
Set Rs1 = New Recordset
'SQL = "Select TOP 10 * from PRODUCT where PRODUCTID like '" & Text4 & "%' OR NAME like'" & Text4 & "%'"
SQL = "Select TOP 10 * from PRODUCT where PRODUCTID='" & Text4 & "' OR NAME like'" & Text4 & "%'"
Set Rs1 = DCON.Execute(SQL)
'Set DataGrid1.DataSource = RS1
Set RS2 = New Recordset
Set RS2 = DCON.Execute(SQL)
lvLook.ListItems.clear
While Not RS2.EOF
Set LISTITM = lvLook.ListItems.Add(, , RS2!ProductID)
LISTITM.SubItems(1) = RS2!Name
If RS2!UnitsInStock <= 0 Then
LISTITM.ForeColor = vbRed
LISTITM.ListSubItems(1).ForeColor = vbRed
Else
If RS2!UnitsInStock <= RS2!ReorderLevel Then
LISTITM.ForeColor = vbBlue
LISTITM.ListSubItems(1).ForeColor = vbBlue
End If
End If
RS2.MoveNext
Wend
If Text4.text <> "" Then
If Not Rs1.EOF Then
' TXT_CODE.SelStart = PRILEN
' TXT_CODE.text = RS1!Name
' TXT_CODE.SelLength = Len(TXT_CODE.text)
'
FVAL = Rs1!ProductID
txtRate.text = Rs1!UnitSellingPrice
text5.text = Val(txtQTY.text) * Val(txtRate.text)
'lblselling.Caption = RS1!UnitSellingPrice
'lblunit.Caption = RS1!UnitsInStock
With lvMain
If .ListItems.Count <> 0 Then
For DD = 1 To .ListItems.Count
If InStr(1, .ListItems(DD).SubItems(1), Rs1!ProductID) = 1 Then
.ListItems(DD).Selected = True
' lblunit.Caption = Val(lblunit.Caption) - Val(.ListItems(DD).SubItems(3))
End If
Next
End If
End With
Else
txtRate.text = ""
text5.text = ""
' TXT_QTY.text = ""
' lblselling.Caption = ""
' lblunit.Caption = ""
' lblcat.Caption = ""
' PRILEN = 0
End If
Set RS2 = Nothing
Set Rs1 = Nothing
Set DCON = Nothing
ElseIf Text4.text = "" Then
txtRate.text = ""
text5.text = ""
txtQTY.text = ""
'lblcat.Caption = ""
'EDT = False
'TXT_RATE.text = ""
'TXT_AMT.text = ""
'TXT_QTY.text = ""
'lblselling.Caption = ""
'lblunit.Caption = ""
'TXT_CODE.SetFocus
End If
End If
End Sub
Private Sub txtqty_Change()
text5.text = Val(txtQTY.text) * Val(txtRate.text)
If Len(txtQTY.text) <> 0 Then
txtRate.Enabled = True
Else
txtRate.Enabled = False
End If
If Len(txtRate.text) <> 0 And Val(txtRate.text) <> 0 And Val(txtQTY.text) <> 0 Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
End Sub
Private Sub txtQTY_GotFocus()
If Text4.text <> "" Then
Call GetNewConnection2
Set Rs1 = New Recordset
SQL = "Select TOP 10 * from PRODUCT where PRODUCTID='" & Text4 & "' OR NAME like'" & Text4 & "%'"
Set Rs1 = DCON.Execute(SQL)
If Rs1.RecordCount <> 0 Then
If Rs1!UnitsInStock <= 0 Then
MsgBox "This Product is out of Stock", vbInformation
Text4.SetFocus
Text4.SelStart = 0
Text4.SelLength = Len(Text4.text)
End If
End If
Set Rs1 = Nothing
Set DCON = Nothing
End If
End Sub
Private Sub txtqty_KeyPress(KeyAscii As Integer)
Call OFFCHar(KeyAscii, txtQTY)
If KeyAscii = 13 Then
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * From Product where ProductID='" & Text4 & "' OR Name='" & "'")
If Rs1.RecordCount <> 0 Then
If Rs1!UnitsInStock < txtQTY.text Then
MsgBox "The Quantity needed is greater than Stock", vbInformation
txtQTY.SetFocus
txtQTY.SelStart = 0
txtQTY.SelLength = Len(txtQTY.text)
End If
End If
Set Rs1 = Nothing
Set DCON = Nothing
End If
End Sub
Private Sub txtRate_Change()
text5.text = Val(txtQTY.text) * Val(txtRate.text)
If Len(txtRate.text) <> 0 And Val(txtRate.text) <> 0 And Val(txtQTY.text) <> 0 Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
End Sub
Private Sub txtRate_GotFocus()
If Len(txtRate.text) <> 0 And Val(txtRate.text) <> 0 And Val(txtQTY.text) <> 0 Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
If Val(txtQTY.text) <> 0 Then
Call GetNewConnection2
Set Rs1 = New Recordset
Set Rs1 = DCON.Execute("Select * From Product where ProductID='" & Text4 & "' OR Name='" & "'")
If Rs1.RecordCount <> 0 Then
If Rs1!UnitsInStock < txtQTY.text Then
MsgBox "The Quantity needed is greater than Stock", vbInformation
txtQTY.SetFocus
txtQTY.SelStart = 0
txtQTY.SelLength = Len(txtQTY.text)
End If
End If
Set Rs1 = Nothing
Set DCON = Nothing
Else
MsgBox "Please give specific quantity needed", vbInformation
txtQTY.SetFocus
End If
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
Call Decimals(KeyAscii, txtRate, 2)
If KeyAscii = 13 Then
Call GetNewConnection2
Set Rs1 = New Recordset
SQL = "Select TOP 5 * from PRODUCT where PRODUCTID like '" & Text4 & "%' OR NAME like'" & Text4 & "%'"
Set Rs1 = DCON.Execute(SQL)
SQL = "Select * from Product where (PRODUCTID='" & Rs1!ProductID & "' AND UnitCostPrice <" & Val(txtRate.text) & ")"
Set Rs1 = DCON.Execute(SQL)
If Rs1.RecordCount <> 0 Then
SQL = "UPDATE PRODUCT set UnitSellingPrice=" & Val(txtRate.text) & " where (PRODUCTID='" & Rs1!ProductID & "' AND UnitCostPrice <" & Val(txtRate.text) & ")"
DCON.Execute SQL
Call cmdAdd_Click
txtRate.SetFocus
Else
SQL = "Select * from PRODUCT where PRODUCTID like '" & Text4 & "%' OR NAME like'" & Text4 & "%'"
Set Rs1 = DCON.Execute(SQL)
If Rs1!UnitSellingPrice <> txtRate.text Then
MsgBox "Cannot Update UnitSellingPrice" & vbTab, vbInformation
End If
If Rs1.RecordCount <> 0 Then
txtRate.text = Rs1!UnitSellingPrice
End If
End If
Set Rs1 = Nothing
Set DCON = Nothing
End If
End Sub
