frmstocksp.frm

网上销售源代码

Set Ars = SQLDB.Execute(sql)
If Ars.EOF Then
    MsgBox "当前单据号不存在，不能修改进货单据", vbInformation, "提示"
    Exit Sub
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 = "Update StockOrder set DepartmentID='" & Trim(cboDepartmentID.Text) & "',AreaStorID='" & Trim(cboAreaStorID.Text) & "'," & _
      "AudDate='" & Format(DTPAudDate.Value, "yyyy-mm-dd") & "',Auder='" & Trim(txtAuder.Text) & "'," & _
      "Updater='" & Trim(PubUserID) & "',UpdateTime='" & Now & "',Remark='" & Trim(txtRemark.Text) & "' Where " & _
      "Billno='" & Trim(txtBillNo.Text) & "'"
SQLDB.Execute sql

'保存明细数据
sql = "Delete StockOrderCargo Where Billno='" & Trim(txtBillNo.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 InitClear()
'清空文本柜数据

ShowID

End Sub

Private Sub Initcbo()
'初使化大类
Dim sql As String
Dim Ars As New ADODB.Recordset

'查询区办信息
sql = "Select AreaStorID from AreaStor"
Set Ars = SQLDB.Execute(sql)
    
Do While Not Ars.EOF
    cboAreaStorID.AddItem Ars("AreaStorID")
Ars.MoveNext
    cboAreaStorID.ListIndex = 0
Loop

'查询门市信息
sql = "Select DepartmentID from Department"
Set Ars = SQLDB.Execute(sql)
    
Do While Not Ars.EOF
    cboDepartmentID.AddItem Ars("DepartmentID")
Ars.MoveNext
    cboDepartmentID.ListIndex = 0
Loop

End Sub

Public Sub Initfg()
    fg.Clear
    fg.Rows = 2
    fg.Cols = 6
    fg.FormatString = "序号  |<自动编号  |<货品编号        |<货品名称          |<单位             |<数量                     "
    fg.ColWidth(1) = 0
    
    ShowID
End Sub

Public Sub ShowID()
Dim i As Integer

    '计算网格有多少行
    For i = 1 To fg.Rows - 1
        fg.TextMatrix(i, 0) = i
    Next
End Sub

Public Sub ShowInfo()
'显示数据
Dim sql As String
Dim Ars As New ADODB.Recordset

'显示主表信息
sql = "Select * from StockOrder Where Billno='" & P_SID & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
    txtBillNo.Text = P_SID
    cboAreaStorID.ListIndex = getComIndex(cboAreaStorID, Ars("AreaStorID"))
    cboDepartmentID.ListIndex = getComIndex(cboDepartmentID, Ars("DepartmentID"))
    DTPAudDate.Value = Ars("AudDate")
    txtRemark.Text = Ars("Auder")
    txtAuder.Text = Ars("Remark")
Else
    Unload Me

End If

'显示子表信息
sql = "SELECT StockOrderCargo.ID, StockOrderCargo.CargoID AS 货品编号," & _
      "Cargo.CargoName AS 货品名称, StockOrderCargo.Unit AS 单位," & _
      "StockOrderCargo.Amount AS 数量 " & _
      "FROM StockOrderCargo left JOIN " & _
      "Cargo ON StockOrderCargo.CargoID = Cargo.CargoID Where StockOrderCargo.Billno='" & P_SID & "'"
Set Ars = SQLDB.Execute(sql)
FillGrid Ars, fg, True
fg.FixedRows = 1

End Sub

Private Sub MoveNextCell()
    Dim i As Integer, blnAddRow As Boolean
    
    '移到下一单元格
    blnAddRow = False
    
    If fg.Col = fg.Cols - 1 Or fg.Col = 5 Then
                       
        For i = 0 To fg.Cols - 1
            If Trim(fg.TextMatrix(fg.Row, i)) <> "" Then
                blnAddRow = True
                Exit For
            End If
        Next
        
        If blnAddRow Then
            If fg.Row = fg.Rows - 1 Then  '若到了倒数第二行的最后一列则添加一行
                fg.Rows = fg.Rows + 1
            End If
            fg.Row = fg.Row + 1
        Else
            fg.Row = 1
        End If
        
        fg.Col = 0
    Else
        Select Case fg.Col
            Case 0
                fg.Col = fg.Col + 1
            Case 2
                fg.SetFocus
                fg.Col = fg.Col + 2
            Case 3
                fg.Col = fg.Col + 1
            Case Else
                fg.Col = fg.Col + 1
        End Select
    End If
'    If Not blnEnterCell Then
'        fg.Col = 3
'        blnEnterCell = True
'    End If
    fg_EnterCell
End Sub

Private Sub txtCargo_KeyDown(KeyCode As Integer, Shift As Integer)
Dim TempString As String

    '在明细记录编辑控件上按下回车键时移动到下一个单元格
    If KeyCode = vbKeyReturn Then
        If fg.Col = 0 Then
            Exit Sub
        ElseIf fg.Col = 1 Then
            If getServerSheetData = False Then
                Exit Sub
            Else
                fg.SetFocus
                fg.Col = 5
'                MoveNextCell
            End If
        ElseIf fg.Col = 2 Then
            If getServerSheetData() = False Then
                Exit Sub
            Else
                fg.SetFocus
                fg.Col = 5
'                MoveNextCell
            End If
        ElseIf fg.Col = 3 Then
            MoveNextCell
        ElseIf fg.Col = 4 Then
            MoveNextCell
        ElseIf fg.Col = 5 Then
                
                If fg.TextMatrix(fg.Row, 2) = "" Or Trim(txtCargo.Text) = "" Then
                    fg.Col = 5
                    txtCargo.SetFocus
                    Exit Sub
                Else
                    fg.TextMatrix(fg.RowSel, fg.ColSel) = txtCargo.Text
                    txtCargo.Visible = False
                    fg.SetFocus
                    If fg.Row = fg.Rows - 1 Then
                        fg.Rows = fg.Rows + 1
                        fg.Row = fg.Row + 1
                        fg.Col = 1
                        fg.SetFocus
                    Else
                        fg.Row = fg.Row + 1
                        fg.Col = 1
                        fg.SetFocus
                    End If
                    fg_EnterCell
                    txtCargo.Text = ""
                    ShowID
                    
                    fg.SetFocus
                    fg.Col = 2
                    fg.SetFocus
                End If
        End If
    Else
        If fg.Col = 0 Then
            If KeyCode = 37 Or KeyCode = 46 Then
            Else
                txtCargo.SelLength = 1
            End If
        End If
    End If
    
End Sub

Function getServerSheetData() As Boolean
On err GoTo ErrHandle
Dim strSql As String
Dim Ars As New ADODB.Recordset
    getServerSheetData = False
    fg.TextMatrix(fg.Row, 2) = txtCargo.Text
    strSql = "select * from Cargo where CargoID = '" & Trim(fg.TextMatrix(fg.Row, 2)) & "'"
    Set Ars = SQLDB.Execute(strSql)
    If Ars.EOF And Ars.BOF Then
        fg.TextMatrix(fg.Row, 3) = ""
        fg.TextMatrix(fg.Row, 4) = ""
        fg.TextMatrix(fg.Row, 5) = ""
        getServerSheetData = False
        Exit Function
    Else
        If fg.TextMatrix(fg.Row, 2) = "" Then
'            fg.Rows = fg.Rows + 1
        End If
        fg.TextMatrix(fg.Row, 2) = Me.txtCargo.Text
        txtCargo.Visible = False
        
        fg.TextMatrix(fg.Row, 3) = IIf(IsNull(Ars.Fields("CargoName")), "", Trim(Ars.Fields("CargoName")))
        fg.TextMatrix(fg.Row, 4) = IIf(IsNull(Ars.Fields("Unit")), "", Trim(Ars.Fields("Unit")))
        fg.SetFocus
        fg.Col = fg.Col + 3
    End If
    
    ShowID
    getServerSheetData = True
    Exit Function
ErrHandle:
    getServerSheetData = False
End Function

Private Sub InitFrom()
'初使化窗体
txtBillNo.Text = GetBillno("SI")
txtRemark.Text = ""

Initfg
End Sub