frmtiaohu.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

         Caption         =   "金额"
         Height          =   180
         Left            =   120
         TabIndex        =   28
         Top             =   2400
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "编号"
         Height          =   180
         Left            =   120
         TabIndex        =   26
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "摘要"
         Height          =   180
         Left            =   120
         TabIndex        =   18
         Top             =   840
         Width           =   360
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "单价"
         Height          =   180
         Left            =   120
         TabIndex        =   17
         Top             =   1920
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "数量"
         Height          =   180
         Left            =   120
         TabIndex        =   16
         Top             =   1320
         Width           =   360
      End
   End
   Begin MSDataListLib.DataCombo DACHouse 
      DataField       =   "FHouseCode"
      Height          =   330
      Left            =   1320
      TabIndex        =   0
      Top             =   600
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   582
      _Version        =   393216
      Text            =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "调户设置"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   525
      Index           =   0
      Left            =   1680
      TabIndex        =   23
      Top             =   0
      Width           =   2175
   End
   Begin VB.Label Label2 
      Caption         =   "所在库房"
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   600
      Width           =   855
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "调户设置"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   525
      Index           =   1
      Left            =   1720
      TabIndex        =   24
      Top             =   30
      Width           =   2175
   End
End
Attribute VB_Name = "frmTiaohu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_HouseRs As ADODB.Recordset

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
'先检查是否有效,应该检查该库房是否由该种商品
Dim result As Boolean
result = RsIsEmpty("select Fwarescode from balance where Fwarescode='" & txtcode(0).Text & "' and FHousecode = '" & DACHouse.BoundText & "'")
If result Then GoTo CheckErr
result = RsIsEmpty("select Fwarescode from balance where Fwarescode='" & txtcode(1).Text & "' and FHousecode = '" & DACHouse.BoundText & "'")
If result Then GoTo CheckErr
'检查单价，金额，数量、
If Abs(Val(txtQuantity(0).Text)) <> Abs(Val(txtQuantity(1).Text)) Then GoTo CheckErr
If Val(txtPrice(0).Text) <> Val(txtPrice(1).Text) Then GoTo CheckErr
If Abs(Val(txtMoney(0).Text)) <> Abs(Val(txtMoney(1).Text)) Then GoTo CheckErr
If Val(txtQuantity(0).Text) * Val(txtPrice(0).Text) <> Val(txtMoney(0).Text) Then
    If vbYes <> MsgBox("单价*数量 <>金额,您确认输入正确吗", vbYesNoCancel, "提示") Then
        Exit Sub
    End If
End If

'在写入明细帐
Dim strSQL As String 'tiao_HU
Dim i As Integer, nAffected As Integer
For i = 0 To 1
    If OptionDr(i).Value Then
        strSQL = "insert into ledger(FYear,FMonth,Fdate,FhouseCode,Fwarescode,FFlag,Fabstract,FDiaoBoInQuantity,FDiaoBoInPrice,FDiaoBoInMoney) "
    Else
        strSQL = "insert into ledger(FYear,FMonth,Fdate,FhouseCode,Fwarescode,FFlag,Fabstract,FDiaoBoOutQuantity,FDiaoBoOutPrice,FDiaoBoOutMoney) "
    End If
    strSQL = strSQL & "select " & m_gnYear & "," & m_gbyMonth & ", #" & m_gLoginDate & "#,'" & DACHouse.BoundText & "','" & txtcode(i).Text & "'," & TIAO_HU & ",'" & txtAbstract(i) & "'," & txtQuantity(i).Text & "," & txtPrice(i).Text & "," & txtMoney(i).Text
    m_gDBCnn.Execute strSQL, nAffected
    If nAffected <> 1 Then GoTo InsertErr
Next i
MsgBox "调户完毕!"
Unload Me
Exit Sub
CheckErr:
    MsgBox "商品编码或调进与调出的单价、数量、金额可能不符合"
    Exit Sub
InsertErr:
    MsgBox "记入商品明细分类帐出错！"
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And UCase(Me.ActiveControl.Name) <> "CMDOK" Then SendKeys "{TAB}"

End Sub

Private Sub Form_Load()
Set m_HouseRs = New ADODB.Recordset
    m_HouseRs.Open "Select FHouseCode, FHouseName From Warehouse Order by FHouseCode", m_gDBCnn
    With DACHouse
        Set .RowSource = m_HouseRs
        .ListField = "FHouseName"
        .BoundColumn = "FHouseCode"
        .BoundText = m_HouseRs!Fhousecode
    End With
    
End Sub

Private Sub txtcode_Validate(Index As Integer, Cancel As Boolean)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select fname from wareslist where FWaresCode ='" & txtcode(Index).Text & "'", m_gDBCnn, adOpenStatic, adLockReadOnly
If rs.EOF And rs.BOF Then
    MsgBox "商品编号有误,请重新输入!"
    Cancel = True
    Exit Sub
End If
Frame1(Index).Caption = Choose(Index + 1, "源", "目标") & "商品户 : " & rs!FName
rs.Close
End Sub

Private Sub txtQuantity_Change(Index As Integer)
If Index = 0 Then
    txtQuantity(1).Text = Abs(Val(txtQuantity(0).Text)) * IIf(Sgn(Val(txtQuantity(1).Text)) >= 0, 1, -1)
Else
    txtQuantity(0).Text = Abs(Val(txtQuantity(1).Text)) * IIf(Sgn(Val(txtQuantity(0).Text)) >= 0, 1, -1)
End If
End Sub

Private Sub txtQuantity_Validate(Index As Integer, Cancel As Boolean)
If Not IsNumeric(txtQuantity(Index).Text) Then
     MsgBox "输入数据无效!"
     Cancel = True
End If
txtMoney(Index).Text = Format(Val(txtQuantity(Index).Text) * Val(txtPrice(Index).Text))
End Sub
Private Sub txtMoney_Validate(Index As Integer, Cancel As Boolean)
If Not IsNumeric(txtMoney(Index).Text) Then
     MsgBox "输入数据无效!"
     Cancel = True
End If
If Val(txtQuantity(Index).Text) <> 0 Then
    txtPrice(Index).Text = Format(Val(txtMoney(Index).Text) / Val(txtQuantity(Index).Text))
Else
    txtPrice(Index).Text = "0"
End If
End Sub
Private Sub txtPrice_Validate(Index As Integer, Cancel As Boolean)
If Not IsNumeric(txtPrice(Index).Text) Then
     MsgBox "输入数据无效!"
     Cancel = True
End If
End Sub