frmyh_yetjbqc.frm

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

                                     "VALUES(" + CStr(GetMaxID("tZW_Pzsj" & glo.sOperateYear, "ID")) + ",20,'银行','0000'," & maxJlhm + 1 & ",'" & _
                                            Format(dtpQyrq.value, "yyyy-mm-dd") & "','" & _
                                            frmYH_Yhkmxz.Kmdm & "','借'," & _
                                            Format(txtDwtzqye.text, "###0.00") & ",2)"
            Case "ORACLE"
                adoCmd.CommandText = "INSERT INTO tZW_pzsj" & glo.sOperateYear & "(id,kjqj,pzzl,pzbh,jlhm,pzrq,kmdm,fx,je,xgbz) " & _
                                     "VALUES(" + CStr(GetMaxID("tZW_Pzsj" & glo.sOperateYear, "ID")) + ",20,'银行','0000'," & maxJlhm + 1 & ",TO_DATE('" & _
                                            Format(dtpQyrq.value, "yyyy-mm-dd") & "','YYYY-MM-DD'),'" & _
                                            frmYH_Yhkmxz.Kmdm & "','借'," & _
                                            Format(txtDwtzqye.text, "###0.00") & ",2)"
        End Select
        IsExistDwtzqye = True
    End If
    adoCmd.Execute
End Sub


Private Sub txtDwtzqye_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        With txtDwtzqye
            If Len(.text) = 15 And .SelLength = 0 Then
                KeyAscii = 0
            Else
                If Len(.text) = 12 And KeyAscii <> 8 And KeyAscii <> 10 Then
                    If InStr(1, .text, ".") = 0 Then
                        KeyAscii = Asc(".")
                    End If
                Else
                    KeyAscii = DoubleEnabled(.text, KeyAscii)
                End If
            End If
        End With
    End If
End Sub

Private Sub txtYhtzqye_GotFocus()
    txtYhtzqye.text = Format(txtYhtzqye.text, "###0.00")
    txtYhtzqye.Alignment = 0
    txtYhtzqye.SelStart = 0
    txtYhtzqye.SelLength = Len(txtYhtzqye.text)
End Sub

Private Sub txtYhtzqye_LostFocus()
    Dim maxId As Integer
    
    txtYhtzqye.Alignment = 1
    If txtYhtzqye.text = "" Then
        txtYhtzqye.text = "0.00"
    Else
        txtYhtzqye.text = Format(txtYhtzqye.text, "##,##0.00")
    End If
    txtYhtzhye.text = Format(Val(Format(txtYhtzqye.text, "###0.00")) + _
                             Val(Format(txtDwys.text, "###0.00")) - _
                             Val(Format(txtDwyf.text, "###0.00")), "##,##0.00")
     
    If IsExistYhtzqye Then
        Select Case g_FLAT
            Case "SQL"
                adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " " & _
                                        "SET rq = '" & Format(dtpQyrq.value, "yyyy-mm-dd") & "'," & _
                                            "je = " & Format(txtYhtzqye.text, "###0.00") & _
                                        " WHERE qcbz = 0 AND kmdm = '" & frmYH_Yhkmxz.Kmdm & "'"
            Case "ORACLE"
                adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " " & _
                                        "SET rq = TO_DATE('" & Format(dtpQyrq.value, "yyyy-mm-dd") & _
                                        "','YYYY-MM-DD')," & _
                                            "je = " & Format(txtYhtzqye.text, "###0.00") & _
                                        " WHERE qcbz = 0 AND kmdm = '" & frmYH_Yhkmxz.Kmdm & "'"
        End Select
    Else
        Set rstTemp = New ADODB.Recordset
        rstTemp.CursorLocation = adUseClient
        sSQL = "SELECT MAX(id) maxId FROM tZW_yhdzd" & glo.sOperateYear
        rstTemp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If rstTemp.BOF And rstTemp.EOF Then
            maxId = 0
        ElseIf IsNull(rstTemp.Fields("maxId").value) Then
            maxId = 0
        Else
            maxId = rstTemp.Fields("maxId").value
        End If
            
        Select Case g_FLAT
            Case "SQL"
                adoCmd.CommandText = "INSERT INTO tZW_Yhdzd" & glo.sOperateYear & "(id,rq,kmdm,fx,je,qcbz) " & _
                                     "VALUES(" & maxId + 1 & ",'" & Format(dtpQyrq.value, "yyyy-mm-dd") & "','" & _
                                                frmYH_Yhkmxz.Kmdm & "','贷'," & _
                                                Format(txtYhtzqye.text, "###0.00") & ",0)"
            Case "ORACLE"
                adoCmd.CommandText = "INSERT INTO tZW_Yhdzd" & glo.sOperateYear & "(id,rq,kmdm,fx,je,qcbz) " & _
                                     "VALUES(" & maxId + 1 & ",TO_DATE('" & Format(dtpQyrq.value, "yyyy-mm-dd") & _
                                                "','YYYY-MM-DD'),'" & _
                                                frmYH_Yhkmxz.Kmdm & "','贷'," & _
                                                Format(txtYhtzqye.text, "###0.00") & ",0)"
        End Select
        IsExistYhtzqye = True
    End If
    adoCmd.Execute
    If Val(txtYhtzhye.text) = 0 Then
        glo.cnnMain.Execute "Delete from tZW_yhdzd" + glo.sOperateYear + " where  je=0 and kmdm='" + frmYH_Yhkmxz.Kmdm + "'"
        Exit Sub
    End If
End Sub

Private Sub txtYhtzqye_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        With txtYhtzqye
            If Len(.text) = 15 And .SelLength = 0 Then
                KeyAscii = 0
            Else
                '当文本框长度到12时, 自动添加小数点;
                If Len(.text) = 12 And KeyAscii <> 8 And KeyAscii <> 10 Then
                    If InStr(1, .text, ".") = 0 Then
                        KeyAscii = Asc(".")
                    End If
                Else
                    KeyAscii = DoubleEnabled(.text, KeyAscii)
                End If
            End If
        End With
    End If
End Sub

'设置打印表格
Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long)
    Dim i As Long, j As Long
    Dim iColWidth() As Integer
    
    With frmP.CllR
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .PrintSetMargin 10, 10, 10, 10
'''''        .DoSetPrintPara 1, 9, True          '设置A4纸张纵向
'''''        .DoSetPrintRange 0, .Cols - 1, 0, .Rows - 1     '设置打印范围
        .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
''        .DoSetDefaultFont 9, 0, "宋体"
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
''''''        .DoSetBackGround 0
''''''        .DoShowCurrentCell False, False
''''''        .AllowSizeColInGrid = True
        
    'Title
        .SetCellAlign COL_START, ROW_TITLE, PageNo - 1, 36
''        .DoSetCellFont COL_START, ROW_TITLE, 18, 5, "黑体"
        .SetCellFont COL_START, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START, ROW_TITLE, PageNo - 1, 10
        .MergeCells COL_START, ROW_TITLE, COL_END, ROW_TITLE
        .SetCellString COL_START, ROW_TITLE, PageNo - 1, "期初余额调节表"
        .SetRowHeight 1, 40, ROW_TITLE, PageNo - 1
    'Comment
        .MergeCells COL_START, ROW_SUBJNAME, COL_MONEY_YH, ROW_SUBJNAME
        .MergeCells COL_ITEM_DW, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        
''        .DoSetCellFont COL_START, ROW_SUBJNAME, 10, 0, "楷体_GB2312"
        .SetCellFont COL_START, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_START, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellAlign COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 34
''        .DoSetCellFont COL_ITEM_DW, ROW_SUBJNAME, 10, 0, "楷体_GB2312"
        .SetCellFont COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, 0
        
        .SetCellString COL_START, ROW_SUBJNAME, PageNo - 1, lblKmmc.Caption
        .SetCellString COL_ITEM_DW, ROW_SUBJNAME, PageNo - 1, lblBeginRq.Caption & _
                                Format(dtpQyrq.value, "yyyy-mm-dd")
    'Head
        For i = ROW_HEAD1 To ROW_HEAD1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
                .SetCellAlign j, i, PageNo - 1, 36
                .SetCellTextStyle j, i, PageNo - 1, 2
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
        Next i
        
        '设置列宽
        iColWidth = GetColWidth(ColWidth)
        For i = LBound(iColWidth) To UBound(iColWidth)
            .SetColWidth 1, iColWidth(i), i + 1, PageNo - 1
        Next i
        .SetColWidth 1, 1, COL_END + 1, PageNo - 1
        
        '合并单元格
        .MergeCells COL_ITEM_YH, ROW_HEAD1, COL_MONEY_YH, ROW_HEAD1
        .MergeCells COL_ITEM_DW, ROW_HEAD1, COL_MONEY_DW, ROW_HEAD1
        
        '设置内容
        .SetCellString COL_ITEM_YH, ROW_HEAD1, PageNo - 1, "银行对账单"
        .SetCellString COL_ITEM_DW, ROW_HEAD1, PageNo - 1, "单位日记账"
        
    'Text
        For i = ROW_GRID_START To .GetRows(PageNo - 1) - 1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_ITEM_YH, i, PageNo - 1, 33
            .SetCellAlign COL_MONEY_YH, i, PageNo - 1, 34
            .SetCellAlign COL_ITEM_DW, i, PageNo - 1, 33
            .SetCellAlign COL_MONEY_DW, i, PageNo - 1, 34
        Next i
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
        
    'Draw Line
     .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
     .DrawGridLine COL_ITEM_YH, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
     .DrawGridLine COL_MONEY_YH, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)
    
''        'Frame
''        .DoDrawHLine COL_START, COL_END, ROW_HEAD1, True, CRB_LINE, 2
''        .DoDrawHLine COL_START, COL_END, .Rows - 1, False, CRB_LINE, 2
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_START, True, CRB_LINE, 2
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_END, False, CRB_LINE, 2
''
''        'Text Vertical
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_ITEM_YH, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_MONEY_YH, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, ROW_HEAD1, COL_ITEM_DW, False, CRB_LINE, 2
''        .DoDrawVLine ROW_GRID_START, .Rows - 1, COL_ITEM_DW, False, CRB_LINE, 1
''        'Text Horizontal
''        For i = ROW_GRID_START To .Rows - 1
''            .DoDrawHLine COL_START, COL_END, i, True, CRB_LINE, 1
''        Next i
    'Print Corp & Date & Time
        .SetRows .GetRows(PageNo - 1) + 1, PageNo - 1
        i = .GetRows(PageNo - 1) - 1
        .MergeCells COL_START, i, COL_MONEY_YH, i
        .MergeCells COL_ITEM_DW, i, COL_END, i
        .SetCellAlign COL_START, i, PageNo - 1, 33
        .SetCellAlign COL_ITEM_DW, i, PageNo - 1, 34
''        .DoSetCellFont COL_START, i, 10, 0, "楷体_GB2312"
''        .DoSetCellFont COL_ITEM_DW, i, 10, 0, "楷体_GB2312"
        .SetCellFont COL_START, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, i, PageNo - 1, 11
        .SetCellFontStyle COL_START, i, PageNo - 1, 0
        .SetCellFont COL_ITEM_DW, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_ITEM_DW, i, PageNo - 1, 11
        .SetCellFontStyle COL_ITEM_DW, i, PageNo - 1, 0
        .SetCellString COL_START, i, PageNo - 1, "核算单位：" & sEnterName
        .SetCellString COL_ITEM_DW, i, PageNo - 1, "打印日期：" & Format(Date, "yyyy-mm-dd")
        .ShowPageBreak False
    End With

End Sub

'显示打印结果
Private Sub ShowPrintResult(ByVal sPrtStr As String)
    Dim lPage As Long
    Dim LCount As Long
    
    If Printers.Count = 0 Then
        MsgBox "未安装打印。", vbInformation
        Exit Sub
    End If
    lPage = 0
    LCount = 1
    Call AppendOneRow(ROW_GRID_START + LCount - 1, "调整前余额：", txtYhtzqye.text, _
                    "调整前余额：", txtDwtzqye)
    LCount = LCount + 1
    
    Call AppendOneRow(ROW_GRID_START + LCount - 1, "加：单位已收、银行未收", txtDwys.text, _
                    "加：银行已收、单位未收", txtYhys.text)
    LCount = LCount + 1
    
    Call AppendOneRow(ROW_GRID_START + LCount - 1, "减：单位已付、银行未付", txtDwyf.text, _
                    "减：银行已付、单位未付", txtYhyf.text)
    LCount = LCount + 1
    
    Call AppendOneRow(ROW_GRID_START + LCount - 1, "调整后余额：", txtYhtzhye.text, _
                    "调整后余额：", txtDwtzhye.text)
    
    Call SetGrid(lPage + 1, ROW_GRID_START + LCount)
    frmP.CllR.SetCurSheet 0
    
    Me.Hide
    
    If sPrtStr = "PRINT" Then
        frmP.uPrint
    Else
        frmP.uPreview
    End If
    Me.Show 1
End Sub


'向表格中追加一行
Private Sub AppendOneRow(ByVal i As Long, ByVal sItem_yh As String, _
        ByVal sMoney_yh As String, ByVal sItem_dw As String, ByVal sMoney_dw As String)
        
    With frmP.CllR
        .SetCellString COL_ITEM_YH, i, .GetCurSheet, sItem_yh
        .SetCellString COL_MONEY_YH, i, .GetCurSheet, sMoney_yh
        .SetCellString COL_ITEM_DW, i, .GetCurSheet, sItem_dw
        .SetCellString COL_MONEY_DW, i, .GetCurSheet, sMoney_dw
    End With
    
End Sub

'得到每列宽度
Private Function GetColWidth(ByVal sColWidth As String) As Integer()
    Dim i As Integer
    Dim j As Integer
    Dim iColWidth() As Integer

    i = 0
    ReDim iColWidth(0 To i)
    For j = 1 To Len(sColWidth)
        If j = 1 Then
            iColWidth(i) = Mid(sColWidth, j, 1)
        ElseIf Mid(sColWidth, j, 1) <> "," Then
            iColWidth(i) = iColWidth(i) & Mid(sColWidth, j, 1)
        Else
            i = i + 1
            ReDim Preserve iColWidth(0 To i)
        End If
    Next j
    
    GetColWidth = iColWidth
End Function