frmfi_thpzwizard.frm

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

                        .Item(.Count).DataSet.Add VoucherFlObj  '添加分录
                        iFlhm = iFlhm + 1
                    End If
                Next
    
           Next
'           For i = 1 To .Count
'               If Not .Item(i).CheckBalance Then MsgBox i & "凭证借贷不平衡！", vbInformation: GoTo Err_Exit
'               If .Item(i).CheckDate <> "" Then MsgBox i & "凭证制单日期不在会计期间！", vbInformation: GoTo Err_Exit
'           Next i
      End With
      Exit Function
Err_Exit:
        LoadVoucherMuster = False
        Set VoucherFlObj = Nothing: Set VoucherObj = Nothing
End Function
'-------------由科目代码得到科目名称--------------
Private Function GetSubjectName(ByVal sCode As String, ByVal sYear As String) As String
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open "select kmmc from tZW_km" & sYear & _
                " where rtrim(kmdm)='" & sCode & "'", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        GetSubjectName = Trim$("" & .Fields(0).value)
        .Close
    End With
    
End Function
'===============================================edit end==============================

Private Sub mnuFileExit_Click()
Unload Me
End Sub

Private Sub mnuFilePrint_Click()
Dim frm As New frmcellprint
If mfgRate.Visible = True Then
    Load frm
    PringMfg mfgRate, frm.Cll, True
    Unload frm
End If
End Sub

Private Sub mnuHelp_Click()
    SendKeys "{F1}"
End Sub

Private Sub mnuFilePreview_Click()
Dim frm As New frmcellprint
If mfgRate.Visible = True Then
    Load frm
    PringMfg mfgRate, frm.Cll, False
    Unload frm
End If
End Sub

Private Sub tbr_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "DoAll"
    mnuEditDoall_Click
Case "Print"
    mnuFilePrint_Click
Case "Preview"
    mnuFilePreview_Click
Case "Make"
    mnuEditMake_Click
Case "Pri"
    mnuControlPri_Click
Case "Next"
    mnuControlNext_Click
Case "Exit"
    mnuFileExit_Click
Case "Help"
    mnuHelp_Click
End Select
End Sub
'初始化mfg
Private Sub InitGrid()
mFg.Cols = 4
mFg.Rows = 2
mFg.FormatString = "转账序号|<      摘要       |>凭证类别|>是否制单"
End Sub
'填充mfg
Private Sub FillGrid(ByVal i As Integer)
mFg.TextMatrix(1, 0) = mfgPz.TextMatrix(i, 1)
mFg.TextMatrix(1, 1) = mfgPz.TextMatrix(i, 8)
mFg.TextMatrix(1, 2) = mfgPz.TextMatrix(i, 2)
mFg.TextMatrix(1, 3) = "√"
End Sub
'填充mfgRate
Private Sub FillmfgRate()
Dim rSt As New Recordset
Dim sSQL As String
Dim i As Integer
Dim sFormatString As String
sSQL = ""
i = 1
While i < mFg.Rows
    If mFg.TextMatrix(i, 3) = "√" Then
        sSQL = sSQL + "or b.ID='" + mFg.TextMatrix(i, 0) + "'"
    End If
    i = i + 1
Wend
If sSQL = "" Then mnuEditMake.Enabled = False: tbr.Buttons("Make").Enabled = False
mfgRate.Rows = 1
mfgRate.Cols = 10
mfgRate.Rows = 2
mfgRate.FormatString = "  |<科目代码    |<科目名称|<方向|<币种|>外币余额         |>本位币余额       |>调整汇率  |>  调整后余额  |>   差额   "
mfgRate.RowHeight(0) = 300
SetAlign mfgRate
If Trim(sSQL) = "" Then Exit Sub
sSQL = "Select a.kmdm kmdm,a.kmmc kmmc,a.yefx yefx,b.bz bz," + _
    "a.ljjwb00 ncjwb,a.ljdwb00 ncdwb,a.ljj00 ncjje,a.ljd00 ncdje," + _
    "a.ljjwb" + Format(kjqj - 1, "00") + " qcjwb," + _
    "a.ljdwb" + Format(kjqj - 1, "00") + " qcdwb," + _
    "a.ljj" + Format(kjqj - 1, "00") + " qcjje," + _
    "a.ljd" + Format(kjqj - 1, "00") + " qcdje," + _
    "a.ljjwb" + Format(kjqj, "00") + " dqjwb," + _
    "a.ljdwb" + Format(kjqj, "00") + " dqdwb," + _
    "a.ljj" + Format(kjqj, "00") + " dqjje," + _
    "a.ljd" + Format(kjqj, "00") + " dqdje," + _
    "b.thzq thzq,c.nFlat_tz tzhl," + _
    "d.bCal Cal,d.iDec Dec,d.mError Error,b.sykmdm sykm,b.sskmdm sskm" + _
    " from tZw_balance" + glo.sOperateYear + _
    " a,tZw_zzhdSet" + glo.sOperateYear + _
    " b,tZW_Exch" + glo.sOperateYear + " c,tZW_ForeignCurrency" & glo.sOperateYear & " d where " + _
    Mid(sSQL, 3) + " and a.kmdm=b.kmdm and c.cExch_name=b.bz and c.iPeriod=" + CStr(kjqj) + " and c.cExch_name=d.cExch_name order by a.kmdm,b.ID"
rSt.Open sSQL, glo.cnnMain, adOpenKeyset, adLockPessimistic
sFormatString = ""
While Not rSt.EOF
    Sykmdm = rSt.Fields("sykm").value
    Sskmdm = rSt.Fields("sskm").value
    For i = 1 To rSt.Fields("Dec").value
        sFormatString = sFormatString + "0"
    Next i
    If Trim(sFormatString) = "" Then
        sFormatString = "#,###0.00"
    Else
        sFormatString = "#,###0." + sFormatString
    End If
    'mFgrate.TextMatrix(i, 1) = "" + rSt.Fields("jlfl").Value
    mfgRate.TextMatrix(mfgRate.Rows - 1, 1) = "" + rSt.Fields("Kmdm").value
    mfgRate.TextMatrix(mfgRate.Rows - 1, 2) = "" + rSt.Fields("kmmc").value
    mfgRate.TextMatrix(mfgRate.Rows - 1, 3) = "" + rSt.Fields("yeFx").value
    mfgRate.TextMatrix(mfgRate.Rows - 1, 4) = "" + rSt.Fields("bz").value
    If "" + rSt.Fields("thzq").value = "每年一次" Then
        If Trim("" + rSt.Fields("yefx").value) = "借方" Then
            mfgRate.TextMatrix(mfgRate.Rows - 1, 5) = Format(rSt.Fields("dqjwb").value - rSt.Fields("dqdwb").value, sFormatString)
            mfgRate.TextMatrix(mfgRate.Rows - 1, 6) = Format(rSt.Fields("dqjje").value - rSt.Fields("dqdje").value, "#,###0.00")
            mfgRate.TextMatrix(mfgRate.Rows - 1, 7) = rSt.Fields("tzhl").value
        Else
            mfgRate.TextMatrix(mfgRate.Rows - 1, 5) = Format(rSt.Fields("dqdwb").value - rSt.Fields("dqjwb").value, sFormatString)
            mfgRate.TextMatrix(mfgRate.Rows - 1, 6) = Format(rSt.Fields("dqdje").value - rSt.Fields("dqjje").value, "#,###0.00")
            mfgRate.TextMatrix(mfgRate.Rows - 1, 7) = rSt.Fields("tzhl").value
        End If
    Else
        If Trim("" + rSt.Fields("yefx").value) = "借方" Then
            mfgRate.TextMatrix(mfgRate.Rows - 1, 5) = Format(rSt.Fields("dqjwb").value - rSt.Fields("dqdwb").value, sFormatString)
            mfgRate.TextMatrix(mfgRate.Rows - 1, 6) = Format(rSt.Fields("dqjje").value - rSt.Fields("dqdje").value, "#,###0.00")
            mfgRate.TextMatrix(mfgRate.Rows - 1, 7) = rSt.Fields("tzhl").value
        Else
            mfgRate.TextMatrix(mfgRate.Rows - 1, 5) = Format(rSt.Fields("dqdwb").value - rSt.Fields("dqjwb").value, sFormatString)
            mfgRate.TextMatrix(mfgRate.Rows - 1, 6) = Format(rSt.Fields("dqdje").value - rSt.Fields("dqjje").value, "#,###0.00")
            mfgRate.TextMatrix(mfgRate.Rows - 1, 7) = rSt.Fields("tzhl").value
        End If
    End If
    If CDbl(mfgRate.TextMatrix(mfgRate.Rows - 1, 7)) = 0 Then
        mfgRate.TextMatrix(mfgRate.Rows - 1, 8) = Format(0, "#,###0.00")
    Else
        If rSt.Fields("Cal").value = 0 Then
            mfgRate.TextMatrix(mfgRate.Rows - 1, 8) = Format(CDbl(mfgRate.TextMatrix(mfgRate.Rows - 1, 5)) / CDbl(mfgRate.TextMatrix(mfgRate.Rows - 1, 7)), "#,###0.00")
        Else
            mfgRate.TextMatrix(mfgRate.Rows - 1, 8) = Format(CDbl(mfgRate.TextMatrix(mfgRate.Rows - 1, 5)) * CDbl(mfgRate.TextMatrix(mfgRate.Rows - 1, 7)), "#,###0.00")
        End If
    End If
    mfgRate.TextMatrix(mfgRate.Rows - 1, 9) = Format(mfgRate.TextMatrix(mfgRate.Rows - 1, 8) - mfgRate.TextMatrix(mfgRate.Rows - 1, 6), "#,###0.00")
    rSt.MoveNext
    mfgRate.Rows = mfgRate.Rows + 1
    sFormatString = ""
Wend
rSt.Close
mfgRate.Rows = mfgRate.Rows - 1
ClearmfgRateZero
End Sub
'汇率改变后计算
Private Sub Calculate()
Dim rSt As New Recordset
Dim sFormatString As String
Dim i As Integer
sFormatString = ""
rSt.Open "Select bCal,iDec,mError from tZW_ForeignCurrency" & glo.sOperateYear & "  where cExch_name='" + mfgRate.TextMatrix(txtEdit.Tag, 4) + "'", glo.cnnMain, adOpenKeyset, adLockPessimistic
If Not rSt.EOF Then
    For i = 1 To rSt.Fields("iDec").value
        sFormatString = sFormatString + "0"
    Next i
    If Trim(sFormatString) = "" Then
        sFormatString = "0.00"
    Else
        sFormatString = "0." + sFormatString
    End If
    If rSt.Fields("bCal").value = 0 Then
        If CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 7)) <> 0 Then mfgRate.TextMatrix(txtEdit.Tag, 8) = Format(CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 5)) / CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 7)), "0.00")
    Else
        mfgRate.TextMatrix(txtEdit.Tag, 8) = Format(CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 5)) * CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 7)), "0.00")
    End If
    mfgRate.TextMatrix(txtEdit.Tag, 9) = Format(CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 8)) - CnvDbl(mfgRate.TextMatrix(txtEdit.Tag, 6)), "0.00")
End If
rSt.Close
ClearmfgRateZero
End Sub
'字符串转化成双精度
Private Function CnvDbl(ByVal s As String) As Double
CnvDbl = 0
If IsNumeric(s) Then
    CnvDbl = CDbl(s)
End If
End Function

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    mfgRate.col = 8
End If
KeyAscii = DoubleEnabled(txtEdit.text, KeyAscii)
End Sub

Private Sub txtEdit_LostFocus()
txtEdit.Visible = False
Calculate
End Sub

Private Sub SetAlign(mFg As MSFlexGrid)
Dim L As Long
mFg.row = 0
For L = 0 To mFg.Cols - 1
    mFg.col = L
    mFg.CellAlignment = 4
Next L
mFg.col = 0
mFg.row = 1
End Sub

Public Sub PringMfg(ByVal m_mFg As MSFlexGrid, ByRef Cllr As CELL50Lib.Cell, ByVal IsPrint As Boolean)
    '打印MFG控建
    Dim rr As Long
    Dim cc As Long
    If m_mFg.Rows < 1 Then Exit Sub
    If Printers.Count = 0 Then MsgBox "未安装打印机。", vbInformation: Exit Sub
    Cllr.OpenFile App.Path & "\CellFiles\ThpzWizard.cll", ""
    Cllr.ResetContent
    Cllr.SetRows m_mFg.Rows + 3, 0
    Cllr.SetCols m_mFg.Cols + 2, 0
    
    Cllr.s 1, 1, 0, "汇兑损益"
    Cllr.SetCellAlign 1, 1, 0, 32 + 4
    Cllr.SetCellFontStyle 1, 1, 0, 2
    Cllr.MergeCells 1, 1, Cllr.GetCols(0) - 1, 1

    Cllr.SetCellFontSize 1, 1, 0, 16
    Cllr.SetRowHeight 1, 28, 1, 0
    
    
    Cllr.s 1, 2, 0, Format(PzDate, "yyyy年mm月dd日")
    Cllr.SetCellAlign 1, 2, 0, 32 + 4
    Cllr.SetCellFontStyle 1, 2, 0, 2
    Cllr.MergeCells 1, 2, Cllr.GetCols(0) - 1, 2

    Cllr.SetCellFontSize 1, 2, 0, 12
    Cllr.SetRowHeight 1, Cllr.GetRowBestHeight(2), 2, 0
    
    Cllr.PrintSetHead "", "", "总&S页 第&P页"
    Cllr.PrintSetFoot "单位:" + GetEnterpriseName(""), "", "打印日期:" + glo.sOperateDate
    Cllr.DrawGridLine 1, 3, m_mFg.Cols, m_mFg.Rows + 2, 0, 2, 0
    
    For cc = 0 To m_mFg.Cols - 1
        Cllr.SetColWidth 1, m_mFg.ColWidth(cc) / 13, cc + 1, 0
        Cllr.SetCellAlign cc + 1, 3, 0, 32 + 4
        Cllr.s cc + 1, rr + 3, 0, Trim(m_mFg.TextMatrix(rr, cc))
    Next cc
    
    For rr = 1 To m_mFg.Rows - 1
        For cc = 0 To m_mFg.Cols - 1
            Cllr.s cc + 1, rr + 3, 0, Trim(m_mFg.TextMatrix(rr, cc))
            If cc >= 5 Then
                Cllr.SetCellAlign cc + 1, rr + 3, 0, 32 + 2
            Else
                Cllr.SetCellAlign cc + 1, rr + 3, 0, 32 + 1
            End If
        Next cc
    Next rr
    If IsPrint = True Then
        Cllr.PrintSheet 0, 0
    Else
        Cllr.PrintPreview 1, 0
    End If
    Cllr.SaveFile App.Path & "\CellFiles\ThpzWizard.cll", 0
End Sub