frmstocksp.frm

网上销售源代码

Private Sub fg_EnterCell()
 '进入单元格时显示当前单元格内容到相应控件
    Dim i As Integer
    On Error Resume Next

    With fg
        If .Row <= 0 Then Exit Sub
        If .Row >= .Rows Then Exit Sub

        If .Col = 2 Or .Col = 5 Then
            txtCargo.Text = .TextMatrix(.RowSel, .ColSel)
            txtCargo.Left = .CellLeft + .Left
            txtCargo.Top = .CellTop + .Top
            If .Col = .Cols - 1 And .Rows > 5 Then
                txtCargo.Width = .CellWidth - 240
            Else
                txtCargo.Width = .CellWidth
            End If
            txtCargo.Height = .CellHeight
            txtCargo.SelStart = 0
            txtCargo.SelLength = Len(txtCargo)
                    
            txtCargo.Visible = True
                    
            txtCargo.SetFocus
        End If
    End With
    Exit Sub
End Sub

Private Sub fg_GotFocus()
    fg_EnterCell
End Sub

Private Sub fg_LeaveCell()
    Dim i As Integer
    Dim strSql As String, rsMy As New ADODB.Recordset
    Dim strGoods As New ADODB.Parameter
    Dim dtpSell As New ADODB.Parameter
    Dim intBuy As New ADODB.Parameter
    Dim dblOld As New ADODB.Parameter
    Dim dblReal As New ADODB.Parameter
    Dim strGratuity As New ADODB.Parameter
    Dim intGratuity As New ADODB.Parameter
    Dim intFlag As New ADODB.Parameter
    Dim cmdMy As New ADODB.Command
    Dim blnNewGoods As Boolean
    Dim sqlcodechang As String
    Dim rscodechang As New ADODB.Recordset
    Dim newcode As String
    On Error GoTo ErrHandle
    
    blnNewGoods = blnNew
    If blnNew Then
        blnNew = False
    ElseIf fg.Col > 0 Then
        Exit Sub
    End If
            
    With fg
    Select Case .ColSel
        Case 0
            Exit Sub

        Case 2
            If Trim(txtCargo.Text) <> "" Then
                If getServerSheetData = False Then
                    Exit Sub
                End If
            End If
        Case 5
            '合计
'            SumAmount
    End Select
    End With
    
    For i = 0 To fg.Cols - 1
        If Trim(fg.TextMatrix(fg.Row, i)) <> "" Then
            If intRows < fg.Row Then
                intRows = fg.Row
            End If
            Exit For
        End If
    Next
    If intRows = fg.Rows - 1 Then  '若到了倒数第二行的最后一列则添加一行
        fg.Rows = fg.Rows + 1
    End If
    Exit Sub
ErrHandle:
    MsgBox err.Description, vbAbortRetryIgnore, "提示"
End Sub

Private Sub fg_Scroll()
On Error Resume Next
    '滚动条滚动时隐藏个明细记录编辑控件
    txtCargo.Visible = False
End Sub

Private Sub Form_Load()

'初使化下接柜
    Initcbo

'初使化网格
    Initfg
    
'初使化其他
    DTPAudDate.Value = Now
    
'显示数据
If P_SID <> "" Then
    ShowInfo
Else
    txtBillNo.Text = GetBillno("SI")
End If
End Sub

Private Sub tlbOperate_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Key
        Case "update"
            '保存数据
                If P_SID = "" Then
                    Sava
                Else
                    Update
                End If
                
        Case "cancel"
            '撤消
            InitClear
        
        Case "first"
            '首页
            frmMQStorage.mintCurPage = 1
            gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
            P_SID = frmMQStorage.fg.TextMatrix(1, 1)
            
            frmMQStorage.fg.TextMatrix(0, 0) = "序号"
            frmMQStorage.ShowID
            
            If frmMQStorage.mintCurPage = 1 Then
                If frmMQStorage.fg.Row = 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = False
                    Me.tlbOperate.Buttons("prev").Enabled = False
                    Me.tlbOperate.Buttons("next").Enabled = True
                    Me.tlbOperate.Buttons("last").Enabled = True
                End If
            End If
            
        Case "prev"
            '前页
            If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
                If frmMQStorage.mintCurPage <= frmMQStorage.mrstDriveRoom.PageCount Then
                    frmMQStorage.mintCurPage = frmMQStorage.mintCurPage - 1
                    gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
                    P_SID = frmMQStorage.fg.TextMatrix(frmMQStorage.fg.Rows - 1, 1)
                                        frmMQStorage.fg.TextMatrix(0, 0) = "序号"
                    frmMQStorage.ShowID
                End If
            End If
            
            If frmMQStorage.mintCurPage = 1 Then
                If frmMQStorage.fg.Row = 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = False
                    Me.tlbOperate.Buttons("prev").Enabled = False
                    Me.tlbOperate.Buttons("next").Enabled = True
                    Me.tlbOperate.Buttons("last").Enabled = True
                End If
            End If
        
        Case "next"
            '下页
            If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
                frmMQStorage.mintCurPage = frmMQStorage.mintCurPage + 1
                gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
                P_SID = frmMQStorage.fg.TextMatrix(1, 1)
                frmMQStorage.fg.TextMatrix(0, 0) = "序号"
                frmMQStorage.ShowID
            End If
            
            If frmMQStorage.mintCurPage = frmMQStorage.mrstDriveRoom.PageCount Then
                If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = True
                    Me.tlbOperate.Buttons("prev").Enabled = True
                    Me.tlbOperate.Buttons("next").Enabled = False
                    Me.tlbOperate.Buttons("last").Enabled = False
                End If
            End If
            
        Case "last"
            '末页
            frmMQStorage.mintCurPage = -1
            gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
            P_SID = frmMQStorage.fg.TextMatrix(frmMQStorage.fg.Rows - 1, 1)
            frmMQStorage.fg.TextMatrix(0, 0) = "序号"
            frmMQStorage.ShowID
               
            If frmMQStorage.mintCurPage = frmMQStorage.mrstDriveRoom.PageCount Then
                If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
                    Me.tlbOperate.Buttons("first").Enabled = True
                    Me.tlbOperate.Buttons("prev").Enabled = True
                    Me.tlbOperate.Buttons("next").Enabled = False
                    Me.tlbOperate.Buttons("last").Enabled = False
                End If
            End If
            
        Case "quit"
            Unload Me
     End Select
End Sub

Private Sub Sava()
'保存数据
Dim sql     As String
Dim Ars     As New ADODB.Recordset
Dim tBillno As String
Dim i       As Integer
Dim j       As Integer

'单据号不能为空
If Trim(txtBillNo.Text) = "" Then
    MsgBox "单据号不能为空", vbInformation, "提示"
    Exit Sub
End If

'查询单据号是已存在
sql = "Select Billno from StockOrder Where Billno='" & Trim(txtBillNo.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
    tBillno = aa
Else
    tBillno = Trim(txtBillNo.Text)
End If

'区办是否为空
If Trim(cboAreaStorID.Text) = "" Then
    MsgBox "区办信息不能为空", vbInformation, "提示"
    Exit Sub
End If

'查询区办信息是否存在
sql = "Select AreaStorID from AreaStor Where AreaStorID='" & Trim(cboAreaStorID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Ars.EOF Then
    MsgBox "区办信息不存在，请重新配置区办信息后在保存进货通知", vbInformation, "提示"
    Exit Sub
End If

'门市是否为空
If Trim(cboDepartmentID.Text) = "" Then
    MsgBox "门市信息不能为空", vbInformation, "提示"
    Exit Sub
End If

'查询门市信息是否存
sql = "Select DepartmentID from Department Where DepartmentID='" & Trim(cboDepartmentID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Ars.EOF Then
    MsgBox "门市信息不存在，请重新配置门市信息后在保存进货通知", vbInformation, "提示"
    Exit Sub
End If

'判断当前进货单据是否有明细
j = 0
For i = 1 To fg.Rows - 1
    If fg.TextMatrix(i, 2) <> "" Then
        '是否输入的单位
        If fg.TextMatrix(i, 4) = "" Then
            MsgBox "第" & i & "行的单位不能为空", vbInformation, "提示"
            Exit Sub
        End If
        
        '查询是否输入了数量
        If fg.TextMatrix(i, 5) = "" Then
            MsgBox "第" & i & "行的数量不能为空", vbInformation, "提示"
            Exit Sub
        End If
        
        j = j + 1
            
    End If
Next

If j = 0 Then
    MsgBox "明细数据为空，不能保存进货通知单", vbInformation, "提示"
    Exit Sub
End If

'保存主表明细
sql = "Insert into StockOrder(Billno,DepartmentID,AreaStorID,State,AudDate,Auder,Inputer,InputTime,Remark) " & _
      " Values('" & Trim(txtBillNo.Text) & "','" & Trim(cboDepartmentID.Text) & "','" & Trim(cboAreaStorID.Text) & "'," & _
      "1,'" & Format(DTPAudDate.Value, "yyyy-mm-dd") & "','" & Trim(txtAuder.Text) & "','" & Trim(PubUserID) & "'," & _
      "'" & Now & "','" & Trim(txtRemark.Text) & "')"
SQLDB.Execute sql

'保存明细数据
For i = 1 To fg.Rows - 1
    If fg.TextMatrix(i, 2) <> "" Then
        sql = "Insert into StockOrderCargo(Billno,CargoID,Unit,Amount) " & _
              "Values('" & Trim(txtBillNo.Text) & "','" & Trim(fg.TextMatrix(i, 2)) & "'," & _
              "'" & Trim(fg.TextMatrix(i, 4)) & "','" & Trim(fg.TextMatrix(i, 5)) & "')"
        SQLDB.Execute sql
    End If
Next
End Sub

Private Sub Update()
'修改数据
Dim sql     As String
Dim Ars     As New ADODB.Recordset
Dim tBillno As String
Dim i       As Integer
Dim j       As Integer

'单据号不能为空
If Trim(txtBillNo.Text) = "" Then
    MsgBox "单据号不能为空", vbInformation, "提示"
    Exit Sub
End If

'查询单据号是已存在
sql = "Select Billno from StockOrder Where Billno='" & Trim(txtBillNo.Text) & "'"