|
#2
一个人的方向2010-12-05 10:53
不好意思啊 各位！ 刚刚那个问题解决了，又出现了一个问题,当点下图中的“修改和删除商品”，VB就会停止了，像死机一样，什么问题啊
只有本站会员才能查看附件，请 登录 这是上面图片那个模块的代码：  程序代码：Private Sub mnuAddProducts_Click() If frmLogin.intJobId = 2 Or frmLogin.intJobId = 1 Then frmAddProduct.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuModifyPWD_Click() If frmLogin.intJobId = 1 Then frmModifyPWD.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuModifyStock_Click() If frmLogin.intJobId = 2 Or frmLogin.intJobId = 1 Then frmModifyProduct.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuQuerySales_Click() If frmLogin.intJobId = 3 Or frmLogin.intJobId = 1 Then frmSalesQuery.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuSale_Click() If frmLogin.intJobId = 3 Or frmLogin.intJobId = 1 Then frmSales.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuStockQuery_Click() If frmLogin.intJobId = 2 Or frmLogin.intJobId = 1 Then frmProductQuery.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub Private Sub mnuUser_Click() If frmLogin.intJobId = 1 Then frmUser.Show Else MsgBox "你没有该项权限！", vbExclamation Exit Sub End If End Sub |
谢谢了
只有本站会员才能查看附件，请 登录
程序的代码如下：
程序代码：Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdQuery_Click()
On Error GoTo ErrHandler
Dim strCmand As String
'姓名为空查询全部员工的销售情况
If Trim(cboUserName.Text) = "" Then
If chkTime.Value = vbChecked Then
If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then
MsgBox "结束时间必须大于或等于开始时间！", vbExclamation
dtpEndDate.SetFocus
Exit Sub
Else
strCmand = "SELECT Users.UserName,Products.ProductName," & _
"Products.UnitPrice,Sales.SaleQuantiy,Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _
"' AND Sales.SaleDate<= '" & dtpEndDate.Value & "'"
End If
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID "
End If
Else
'姓名不为空查询查询当前员工的销售情况
If chkTime.Value = vbChecked Then
If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then
MsgBox "结束时间必须大于或等于开始时间！", vbExclamation
dtpEndDate.SetFocus
Exit Sub
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _
"' AND Sales.SaleDate<= '" & dtpEndDate.Value & _
"' and Users.UserName = '" & cboUserName.Text & "'"
End If
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Users.UserName = '" & cboUserName.Text & "'"
End If
End If
Adodc2.RecordSource = strCmand
Adodc2.Refresh
Exit Sub
ErrHandler:
MsgBox "错误号:" & Err.Number & " 错误信息：" & Err.Description
End Sub
Private Sub DataGrid2_Click()
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As ADODB.Recordset
'设置窗体位置
ChangeFormPos frmMain, frmSalesQuery
sql = "select UserName from Users"
Set rs = ExeSQL(sql)
If rs.EOF = True Then
MsgBox "当前数据库中没有信息！", vbExclamation
Else
rs.MoveFirst
Do Until rs.EOF
strUserName = rs!UserName
cboUserName.AddItem strUserName
rs.MoveNext
Loop
rs.Close
End If
dtpStartDate.Value = Now
dtpEndDate.Value = Now
End Sub
Unload Me
End Sub
Private Sub cmdQuery_Click()
On Error GoTo ErrHandler
Dim strCmand As String
'姓名为空查询全部员工的销售情况
If Trim(cboUserName.Text) = "" Then
If chkTime.Value = vbChecked Then
If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then
MsgBox "结束时间必须大于或等于开始时间！", vbExclamation
dtpEndDate.SetFocus
Exit Sub
Else
strCmand = "SELECT Users.UserName,Products.ProductName," & _
"Products.UnitPrice,Sales.SaleQuantiy,Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _
"' AND Sales.SaleDate<= '" & dtpEndDate.Value & "'"
End If
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID "
End If
Else
'姓名不为空查询查询当前员工的销售情况
If chkTime.Value = vbChecked Then
If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then
MsgBox "结束时间必须大于或等于开始时间！", vbExclamation
dtpEndDate.SetFocus
Exit Sub
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _
"' AND Sales.SaleDate<= '" & dtpEndDate.Value & _
"' and Users.UserName = '" & cboUserName.Text & "'"
End If
Else
strCmand = "SELECT Users.UserName, Products.ProductName," & _
"Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _
"FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _
"INNER JOIN Users ON Sales.UserID = Users.UserID " & _
"WHERE Users.UserName = '" & cboUserName.Text & "'"
End If
End If
Adodc2.RecordSource = strCmand
Adodc2.Refresh
Exit Sub
ErrHandler:
MsgBox "错误号:" & Err.Number & " 错误信息：" & Err.Description
End Sub
Private Sub DataGrid2_Click()
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As ADODB.Recordset
'设置窗体位置
ChangeFormPos frmMain, frmSalesQuery
sql = "select UserName from Users"
Set rs = ExeSQL(sql)
If rs.EOF = True Then
MsgBox "当前数据库中没有信息！", vbExclamation
Else
rs.MoveFirst
Do Until rs.EOF
strUserName = rs!UserName
cboUserName.AddItem strUserName
rs.MoveNext
Loop
rs.Close
End If
dtpStartDate.Value = Now
dtpEndDate.Value = Now
End Sub
