frmfi_thpzwizard.frm

一个用VB写的财务软件源码

rSt.Open "Select Distinct(ID),pzlb,thzq,sykmdm,sykmmc,sskmdm,sskmmc,zy,schdrq from tZw_zzhdSet" + glo.sOperateYear + " order by ID", glo.cnnMain, adOpenKeyset, adLockPessimistic
While Not rSt.EOF
    If s <> Trim("" + rSt.Fields("ID").value) Then
        s = Trim("" + rSt.Fields("ID").value)
        mfgPz.TextMatrix(mfgPz.Rows - 1, 1) = s
        mfgPz.TextMatrix(mfgPz.Rows - 1, 2) = "" + rSt.Fields("Pzlb").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 3) = "" + rSt.Fields("thzq").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 4) = "" + rSt.Fields("sykmdm").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 5) = "" + rSt.Fields("sykmmc").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 6) = "" + rSt.Fields("sskmdm").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 7) = "" + rSt.Fields("sskmmc").value
        mfgPz.TextMatrix(mfgPz.Rows - 1, 8) = "" + rSt.Fields("zy").value
        If Not IsNull(rSt.Fields("schdrq").value) Then mfgPz.TextMatrix(mfgPz.Rows - 1, 9) = "" + rSt.Fields("schdrq").value
    End If
    mfgPz.Rows = mfgPz.Rows + 1
    rSt.MoveNext
Wend
rSt.Close
mfgPz.Rows = mfgPz.Rows - 1
End Sub

'菜单控制
Private Sub ControlMenu(ByVal i As String)
Select Case iStep
Case 0
    mnuControlNext.Enabled = True
    tbr.Buttons("Next").Enabled = True
    mnuControlPri.Enabled = False
    tbr.Buttons("Pri").Enabled = False
    mnuEditDoall.Enabled = False
    tbr.Buttons("DoAll").Enabled = False
    mnuEditMake.Enabled = False
    tbr.Buttons("Make").Enabled = False
    mfgPz.Visible = True
    mfgRate.Visible = False
    Frame1.Caption = "第一步"
Case 1
    mnuControlNext.Enabled = False
    tbr.Buttons("Next").Enabled = False
    mnuControlPri.Enabled = True
    tbr.Buttons("Pri").Enabled = True
    mnuEditDoall.Enabled = True
    tbr.Buttons("DoAll").Enabled = True
    mnuEditMake.Enabled = True
    tbr.Buttons("Make").Enabled = True
    mfgPz.Visible = False
    mfgRate.Visible = True
    Frame1.Caption = "第二步"
End Select
End Sub
Private Sub form_load()
Dim rSt As New Recordset
iStep = 0
b = True
InitGrid
InitmfgPz
FillmfgPz
ControlMenu iStep
kjqj = GetPeriod(DateAdd("d", 1, glo.sUnEarlierDate))
PzDate = GetPeriodTo(kjqj)
'rSt.Open "select PeriodID,Todate from tSYS_Period where  AccountID='" + glo.sAccountID + "'  and year='" + glo.sOperateYear + "' and fromDate='" + glo.sUnEarlierDate + "'", gloSys.cnnSYS, adOpenKeyset, adLockPessimistic
'If Not (rSt.EOF And rSt.BOF) Then
'    kjqj = CInt(rSt.Fields(0).Value)
'    PzDate = Format(rSt.Fields(1).Value, "yyyy-mm-dd")
'Else
'    kjqj = CInt(glo.iOperatePeriod)
'    PzDate = glo.sOperateDate
'End If
End Sub

Private Sub Form_Resize()
Frame1.Top = tbr.Height
Frame1.Left = Me.ScaleLeft
Frame1.Width = Me.ScaleWidth
If Me.ScaleHeight - tbr.Height > 0 Then
    Frame1.Height = Me.ScaleHeight - tbr.Height
End If
'7455-7665
'3525-3795
mfgPz.Width = Frame1.Width - 210
mfgPz.Height = Frame1.Height - 270
mfgRate.Width = mfgPz.Width
mfgRate.Height = mfgPz.Height
End Sub

Private Sub mfgPz_DblClick()
If mfgPz.row > 0 Then
    If Trim(mfgPz.TextMatrix(mfgPz.row, 0)) = "" And b Then
        mfgPz.TextMatrix(mfgPz.row, 0) = "√"
        mfgPz.Tag = mfgPz.row
        b = False
        FillGrid mfgPz.row
        Exit Sub
    End If
    If Trim(mfgPz.TextMatrix(mfgPz.row, 0)) = "√" And b = False Then
        b = True
        mfgPz.TextMatrix(mfgPz.row, 0) = ""
        mFg.TextMatrix(1, 3) = ""
        mfgPz.Tag = 0
        Exit Sub
    End If
End If
End Sub

Private Sub mfgRate_EnterCell()
'txtEdit.Left = mfgRate.ColPos(7) + mfgRate.Left
'If mfgRate.Row > 0 And mfgRate.Col = 7 Then
'    txtEdit.Tag = mfgRate.Row
'    txtEdit.Top = mfgRate.RowPos(mfgRate.Row) + mfgRate.Top
'    txtEdit.text = mfgRate.TextMatrix(mfgRate.Row, 7)
'    txtEdit.Visible = True
'End If
End Sub

Private Sub mfgRate_LeaveCell()
If txtEdit.Visible Then
    mfgRate.TextMatrix(txtEdit.Tag, 7) = txtEdit.text
    Calculate
End If

End Sub

Private Sub mfgRate_LostFocus()
Call mfgRate_LeaveCell
End Sub


Private Sub mfgRate_Scroll()
Call mfgRate_LeaveCell
End Sub

Private Sub mnuControlNext_Click()
Dim i As Integer
iStep = iStep + 1
ControlMenu iStep
FillmfgRate
i = 1
While i < mfgRate.Rows
    mfgRate.TextMatrix(i, 0) = "√"
    i = i + 1
Wend
End Sub

Private Sub mnuControlPri_Click()
iStep = iStep - 1
ControlMenu iStep
End Sub

Private Sub mnuEditDoall_Click()
Dim i As Integer
i = 1
While i < mfgRate.Rows
    If mnuEditDoall.Checked = True Then
        mfgRate.TextMatrix(i, 0) = ""
    Else
        mfgRate.TextMatrix(i, 0) = "√"
    End If
    i = i + 1
Wend
mnuEditDoall.Checked = Not mnuEditDoall.Checked
If mnuEditDoall.Checked Then
    tbr.Buttons("DoAll").value = tbrPressed
Else
    tbr.Buttons("DoAll").value = tbrUnpressed
End If
End Sub
'制单
Private Sub mnuEditMake_Click()
Dim frmV As frmVoucher
'转账序号|>摘 要|>科目》方 向|>金 额 |> 出 错 提 示 zdmfg
'转账序号|>转账说明|>凭证类别|>是否制单             mfg
Dim i As Integer
Dim dTotal As Double '汇总金额

zdmFg.Rows = 2
i = 1
While i < mfgRate.Rows
    If CnvDbl(mfgRate.TextMatrix(i, 9)) <> 0 And mfgRate.TextMatrix(i, 0) = "√" Then
        zdmFg.TextMatrix(zdmFg.Rows - 1, 0) = mFg.TextMatrix(1, 0)
        zdmFg.TextMatrix(zdmFg.Rows - 1, 1) = mFg.TextMatrix(1, 1)
        zdmFg.TextMatrix(zdmFg.Rows - 1, 2) = mfgRate.TextMatrix(i, 1)
'        If mfgRate.TextMatrix(i, 9) > 0 Then       '改为单边
            If mfgRate.TextMatrix(i, 3) = "借方" Then
                zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "借"
                dTotal = dTotal + CDbl(mfgRate.TextMatrix(i, 9))
            Else
                zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "贷"
                dTotal = dTotal - CDbl(mfgRate.TextMatrix(i, 9))
            End If
            zdmFg.TextMatrix(zdmFg.Rows - 1, 4) = mfgRate.TextMatrix(i, 9)
'        Else
'            If mfgRate.TextMatrix(i, 3) = "借方" Then
'                zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "贷"
'                dTotal = dTotal + CDbl(mfgRate.TextMatrix(i, 9))
'            Else
'                zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "借"
'                dTotal = dTotal - CDbl(mfgRate.TextMatrix(i, 9))
'            End If
'            zdmFg.TextMatrix(zdmFg.Rows - 1, 4) = Abs(mfgRate.TextMatrix(i, 9))
'        End If
        zdmFg.Rows = zdmFg.Rows + 1
   
        If Trim(mfgRate.TextMatrix(i, 7)) = "" Then
           MsgBox mfgRate.TextMatrix(i, 4) & "的汇率为零,请到汇率设置中进行设置!", vbInformation
           Exit Sub
        End If
    
    End If
    i = i + 1
Wend
dTotal = dTotal * -1
If dTotal <> 0 Then
    zdmFg.TextMatrix(zdmFg.Rows - 1, 0) = mFg.TextMatrix(1, 0)
    zdmFg.TextMatrix(zdmFg.Rows - 1, 1) = mFg.TextMatrix(1, 1)
    If dTotal > 0 Then
        zdmFg.TextMatrix(zdmFg.Rows - 1, 2) = Sskmdm
        zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "借"
    Else
        zdmFg.TextMatrix(zdmFg.Rows - 1, 3) = "贷"
        zdmFg.TextMatrix(zdmFg.Rows - 1, 2) = Sykmdm
    End If
    zdmFg.TextMatrix(zdmFg.Rows - 1, 4) = Abs(dTotal)
End If
If zdmFg.Rows <= 2 Then MsgBox "未发生汇率损益！": Exit Sub
glo.cnnMain.Execute "update tZw_zzhdSet" + glo.sOperateYear + " set schdrq='" + Format(PzDate, "yyyy-mm-dd") + "' where id='" + mFg.TextMatrix(1, 0) + "'"
        '==========================================changjh edit================================================

If Not LoadVoucherMuster Then Exit Sub
Me.Hide
With VoucherMuster
    Set frmV = New frmVoucher
    .Voucher = .Item(1)  '当前凭证
    .Index = 1
    frmV.LoadObject = "AccountExtend.clsVoucherCollentionZz" '初始化凭证窗口的外挂对象
    frmV.AllowAddinObject = True
    Load frmV
    frmV.HelpContextID = 506
    frmV.Show
    frmV.ContorlStatus "新增"
    frmV.LoadingObjects = VoucherMuster
    frmV.Reload .Voucher, VoucherMuster.Voucher.sStatus
'    frmV.ContorlStatus VoucherMuster.Voucher.sStatus
'    frmV.OnVoucherJeChange
End With
Unload Me
End Sub
'-----------装载凭证集---------------
Private Function LoadVoucherMuster() As Boolean
On Error GoTo Err_Exit
        Dim VoucherObj As New VoucherData.clsVoucher '定义凭证
        Dim VoucherFlObj As New VoucherData.clsVoucherData '分录
        Dim iFlhm As Integer '分录号
        Dim i As Integer, j As Integer
        Dim iGlo As New GlobalInterface.clsGlobal, iGlosys As New GlobalInterface.clsGlobalSys
        
        LoadVoucherMuster = True
        
        Set VoucherMuster = Nothing
        Set VoucherMuster = New AccountExtend.clsVoucherCollentionZz
        InitGloInface iGlo, iGlosys
        VoucherMuster.iGlo = iGlo
        VoucherMuster.iGlosys = iGlosys
        
        With VoucherMuster
            For i = 1 To mFg.Rows - 1
                Set VoucherObj = New clsVoucher '添加凭证集合
                VoucherObj.iGlo = iGlo
                VoucherObj.iGlosys = iGlosys
                VoucherObj.sEnterprise = GetEnterName(glo.sAccountID) '单位
                VoucherObj.sVoucherDate = PzDate '日期
                VoucherObj.sMasterMan = "" '主管
                VoucherObj.sMasterManCode = ""
                VoucherObj.sBillMan = glo.sUserName '制单人
                VoucherObj.sBillManCode = glo.sUserID
                VoucherObj.sCheckMan = "" '复合人
                VoucherObj.sCheckManCode = ""
                VoucherObj.sVoucherType = mFg.TextMatrix(i, 2) '凭证类型
                VoucherObj.sStatus = "新增"
                .Add VoucherObj
                iFlhm = 1
                For j = 1 To zdmFg.Rows - 1 '--------分录
                    If Trim$("" & mFg.TextMatrix(i, 0)) = Trim$("" & zdmFg.TextMatrix(j, 0)) Then
                        Set VoucherFlObj = New clsVoucherData
                        VoucherFlObj.Jlhm = iFlhm
                        VoucherFlObj.SubjectCode = Trim$("" & zdmFg.TextMatrix(j, 2)) '科目代码
                        VoucherFlObj.Summary = Trim$("" & zdmFg.TextMatrix(j, 1))
                        VoucherFlObj.SubjectName = GetSubjectName(Trim$("" & zdmFg.TextMatrix(j, 2)), glo.sOperateYear)
                        VoucherFlObj.Fx = Trim$("" & zdmFg.TextMatrix(j, 3))
                        VoucherFlObj.Je = zdmFg.TextMatrix(j, 4)
                        ''''''''''''''
                        '驱除负号
                        If VoucherFlObj.Je < 0 Then
                            If Left$(VoucherFlObj.Fx, 1) = "借" Then
                                VoucherFlObj.Fx = "贷"
                            Else
                                VoucherFlObj.Fx = "借"
                            End If
                            VoucherFlObj.Je = VoucherFlObj.Je * -1
                        End If
                        ''''''''''''
                        VoucherFlObj.zOccurDate = PzDate