⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmin_kmyetz.frm

📁 一个用VB写的财务软件源码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 

Private Sub Form_Resize()

    On Error Resume Next
    cllBalance.Width = Me.ScaleWidth - 200
    cllBalance.Height = Me.ScaleHeight - 800
End Sub

'=====================卸载窗口==============
Private Sub Form_Unload(Cancel As Integer)

If bReadOnly Then Exit Sub
 

cllBalance.SaveEdit
If cllBalance.IsModified = 0 And sXgFlagMuster = "," Then
   Exit Sub
ElseIf MsgBox(" 数据被修改过需要保存吗？ ", vbYesNo, "提示") = vbNo Then
       Exit Sub
ElseIf oSaveBalance Then
       Cancel = 1 '保存数据
End If
End Sub
'============================== 系统装载后对用户操作进行控制的函数和过程  =============================
'==============打印=================
Private Sub oPrintRec(strPrt As String)
Dim rstPrt As New ADODB.Recordset
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim str As String
Dim sStartKm As String
Dim sEndKm As String
Dim sStartJc As Integer
Dim sEndJc As Integer

Dim HjNcJe As Double
Dim HjLjjfJe As Double
Dim HjLjdfJe As Double
Dim HjQcJe As Double
Dim IsTotalKm As Boolean
Dim KmJc As Integer
Dim sFx As String

If Printers.Count = 0 Then MsgBox "未安装打印机。", vbInformation: Exit Sub
frmSelectKmPrint.Show 1
If frmSelectKmPrint.Ok = True Then
    sStartKm = frmSelectKmPrint.txtStartKm
    sEndKm = frmSelectKmPrint.txtEndKm
    sStartJc = frmSelectKmPrint.txtStartJc
    sEndJc = frmSelectKmPrint.txtEndJc
Else
    sStartKm = ""
    sEndKm = ""
    sStartJc = 0
    sEndJc = 0
    Exit Sub
End If
MousePointer = vbHourglass

With cllPrint
    .OpenFile App.Path + "\CellFiles\Kmyetz.cll", ""
    .ResetContent
    .ShowPageBreak 0
    .PrintSetFoot "编制单位:" + GetEnterpriseName(""), "", "打印日期:" + glo.sOperateDate
    .PrintSetHead "", "", "总&S页 第&P页"
    .PrintSetTopTitle 1, 4
    .SetCols iFixCols + iDataCols, 0
    .SetRows iDataRows + 5 + 1, 0 '加1个合计行
    .SetDefaultRowHeight 0, 1, lRowHeight
    .SetDefaultColWidth 0, 1, 120
    .SetColWidth 1, uFxCol.iWidth, uFxCol.iCol, 0
    .MergeCells 2, 1, .GetCols(0), 1: .SetCellAlign 2, 1, 0, 32 + 4: .SetCellFontSize 2, 1, 0, 23: .SetRowHeight 1, 50, 1, 0: .SetCellString 2, 1, 0, "科目期初余额表"
    .s 5, 4, 0, "数量": .s 6, 4, 0, "外币": .s 7, 4, 0, "金额": .s 8, 4, 0, "数量": .s 9, 4, 0, "外币": .s 10, 4, 0, "金额": .s 11, 4, 0, "数量": .s 12, 4, 0, "外币": .s 13, 4, 0, "金额": .s 14, 4, 0, "数量": .s 15, 4, 0, "外币": .s 16, 4, 0, "金额"
    For i = 1 To iFixCols + iDataRows
        .SetCellAlign i, 4, 0, 32 + 4
    Next
    .MergeCells 2, 2, .GetCols(0), 2
    .SetCellString 2, 2, 0, "期初：" & glo.sOperateYear & "年" & IIf(QcYue = "00", "", sBeginMonth & "月")
    .MergeCells 2, 3, 2, 4: .SetCellAlign 2, 3, 0, 32 + 4: .SetCellString 2, 3, 0, "科目代码"
    .MergeCells 3, 3, 3, 4: .SetCellAlign 3, 3, 0, 32 + 4: .SetCellString 3, 3, 0, "科目名称"
    .MergeCells 4, 3, 4, 4: .SetCellAlign 4, 3, 0, 32 + 4: .SetCellString 4, 3, 0, "方向"
    .MergeCells 5, 3, 7, 3: .SetCellAlign 5, 3, 0, 32 + 4: .SetCellString 5, 3, 0, "年初余额"
    .MergeCells 8, 3, 10, 3: .SetCellAlign 8, 3, 0, 32 + 4: .SetCellString 8, 3, 0, "累计借方发生额"
    .MergeCells 11, 3, 13, 3: .SetCellAlign 11, 3, 0, 32 + 4: .SetCellString 11, 3, 0, "累计贷方发生额"
    .MergeCells 14, 3, 16, 3: .SetCellAlign 14, 3, 0, 32 + 4: .SetCellString 14, 3, 0, "期初余额"
    
    For i = 5 To iDataRows + 4
        
         For j = 1 To iFixCols + iDataCols
             If j = 4 Then .SetCellAlign j, i, 0, 32 + 4: sFx = Trim$(cllBalance.GetCellString(j, i - 4 + 1, 0))
             If j > 4 Then
                .SetCellAlign j, i, 0, 32 + 2 '单元格显示方式水平右对其垂直居中
                If j = 7 Or j = 10 Or j = 13 Or j = 16 Then  '金额
                  .SetCellDigital j, i, 0, 2 '小数位数
                ElseIf j = 5 Or j = 8 Or j = 11 Or j = 14 Then '数量
                  .SetCellDigital j, i, 0, 3 '小数位数
                Else
                  .SetCellDigital j, i, 0, 4 '小数位数          '外币
                End If
                .SetCellNumType j, i, 0, 1 '数值类型
                .SetCellHideZero j, i, 0, 1 '隐藏
                .SetCellSeparator j, i, 0, 2 '千分位
'                .SetCellMinus j, i, 0, 5 '红色带负号
                If UBound(arrSlWb) >= i - 3 Then
                    If InStr(1, arrSlWb(i - 3), "wb") <= 0 And (j = 6 Or j = 9 Or j = 12 Or j = 15) Then
                        cllPrint.d j, i, 0, 0
                    ElseIf InStr(1, arrSlWb(i - 3), "sl") <= 0 And (j = 5 Or j = 8 Or j = 11 Or j = 14) Then
                        cllPrint.d j, i, 0, 0
                    Else
                        cllPrint.d j, i, 0, cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                    End If
                 Else
                    cllPrint.d j, i, 0, cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                 End If
                 If IsTotalKm = True Then
                    Select Case j
                    Case 7
                       If Left$(sFx, 1) = "借" Then
                           HjNcJe = HjNcJe + cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                       Else
                           HjNcJe = HjNcJe - cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                       End If
                    Case 10
                       HjNcJe = HjNcJe + cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                    Case 13
                       HjNcJe = HjNcJe + cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                    Case 16
                       If Left$(sFx, 1) = "借" Then
                           HjNcJe = HjNcJe + cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                       Else
                           HjNcJe = HjNcJe - cllBalance.GetCellDouble(j, i - 4 + 1, 0)
                       End If
                    End Select
                 End If
              Else
                If j = 2 Then
                    KmJc = GetKmJc(cllBalance.GetCellString(j, i - 4 + 1, 0)) + 1
                    If KmJc = 1 Or KmJc = CInt(sStartJc) Then
                        IsTotalKm = True
                    Else
                        IsTotalKm = False
                    End If
                End If
                .s j, i, 0, cllBalance.GetCellString(j, i - 4 + 1, 0)
              End If
         Next
         If ((.GetCellString(uKmdmCol.iCol, i, 0) > sEndKm And sEndKm <> "") Or _
            (.GetCellString(uKmdmCol.iCol, i, 0) < sStartKm And sStartKm <> "")) Or _
            ((GetKmJc(.GetCellString(uKmdmCol.iCol, i, 0)) < sStartJc - 1 And sStartJc > 0) Or _
            (GetKmJc(.GetCellString(uKmdmCol.iCol, i, 0)) > sEndJc - 1 And sEndJc >= sStartJc)) Then
            .SetRowHidden i, i
         End If
    Next i
    .MergeCells 2, i, 3, i
    .SetCellAlign 2, i, 0, 32 + 4
    .s 2, i, 0, "合计"
    If Abs(HjNcJe) < 0.005 Then
        .s 4, i, 0, "平"
        .SetCellAlign 4, i, 0, 32 + 4
        .d 10, i, 0, HjLjjfJe
        .SetCellNumType 10, i, 0, 1 '数值类型
        .SetCellHideZero 10, i, 0, 1 '隐藏
        .SetCellSeparator 10, i, 0, 2 '千分位
'        .SetCellMinus 10, i, 0, 5 '红色带负号
        .SetCellDigital 10, i, 0, 2 '小数位数
        .d 13, i, 0, HjLjdfJe
        .SetCellNumType 13, i, 0, 1 '数值类型
        .SetCellHideZero 13, i, 0, 1 '隐藏
        .SetCellSeparator 13, i, 0, 2 '千分位
'        .SetCellMinus 13, i, 0, 5 '红色带负号
        .SetCellDigital 13, i, 0, 2 '小数位数
        If HjQcJe <> 0 Then
            .d 16, i, 0, HjQcJe
            .SetCellNumType 16, i, 0, 1 '数值类型
            .SetCellHideZero 16, i, 0, 1 '隐藏
            .SetCellSeparator 16, i, 0, 2 '千分位
'            .SetCellMinus 16, i, 0, 5 '红色带负号
            .SetCellDigital 16, i, 0, 2 '小数位数
        End If
    ElseIf HjNcJe > 0 Then
        .s 4, i, 0, "借"
        .SetCellAlign 4, i, 0, 32 + 4
        .d 7, i, 0, HjNcJe
        .SetCellNumType 7, i, 0, 1 '数值类型
        .SetCellHideZero 7, i, 0, 1 '隐藏
        .SetCellSeparator 7, i, 0, 2 '千分位
'        .SetCellMinus 7, i, 0, 5 '红色带负号
        .SetCellDigital 7, i, 0, 2 '小数位数
        .d 10, i, 0, HjLjjfJe
        .SetCellNumType 10, i, 0, 1 '数值类型
        .SetCellHideZero 10, i, 0, 1 '隐藏
        .SetCellSeparator 10, i, 0, 2 '千分位
'        .SetCellMinus 10, i, 0, 5 '红色带负号
        .SetCellDigital 10, i, 0, 2 '小数位数
        .d 13, i, 0, HjLjdfJe
        .SetCellNumType 13, i, 0, 1 '数值类型
        .SetCellHideZero 13, i, 0, 1 '隐藏
        .SetCellSeparator 13, i, 0, 2 '千分位
'        .SetCellMinus 13, i, 0, 5 '红色带负号
        .SetCellDigital 13, i, 0, 2 '小数位数
        If HjQcJe <> 0 Then
            .d 16, i, 0, HjQcJe
            .SetCellNumType 16, i, 0, 1 '数值类型
            .SetCellHideZero 16, i, 0, 1 '隐藏
            .SetCellSeparator 16, i, 0, 2 '千分位
'            .SetCellMinus 16, i, 0, 5 '红色带负号
            .SetCellDigital 16, i, 0, 2 '小数位数
        End If
    Else
        .s 4, i, 0, "贷"
        .SetCellAlign 4, i, 0, 32 + 4
        .d 7, i, 0, HjNcJe * -1
        .SetCellNumType 7, i, 0, 1 '数值类型
        .SetCellHideZero 7, i, 0, 1 '隐藏
        .SetCellSeparator 7, i, 0, 2 '千分位
'        .SetCellMinus 7, i, 0, 5 '红色带负号
        .SetCellDigital 7, i, 0, 2 '小数位数
        .d 10, i, 0, HjLjjfJe
        .SetCellNumType 10, i, 0, 1 '数值类型
        .SetCellHideZero 10, i, 0, 1 '隐藏
        .SetCellSeparator 10, i, 0, 2 '千分位
'        .SetCellMinus 10, i, 0, 5 '红色带负号
        .SetCellDigital 10, i, 0, 2 '小数位数
        .d 13, i, 0, HjLjdfJe
        .SetCellNumType 13, i, 0, 1 '数值类型
        .SetCellHideZero 13, i, 0, 1 '隐藏
        .SetCellSeparator 13, i, 0, 2 '千分位
'        .SetCellMinus 13, i, 0, 5 '红色带负号
        .SetCellDigital 13, i, 0, 2 '小数位数
        If HjQcJe <> 0 Then
            .d 16, i, 0, HjQcJe * -1
            .SetCellNumType 16, i, 0, 1 '数值类型
            .SetCellHideZero 16, i, 0, 1 '隐藏
            .SetCellSeparator 16, i, 0, 2 '千分位
'            .SetCellMinus 16, i, 0, 5 '红色带负号
            .SetCellDigital 16, i, 0, 2 '小数位数
        End If
    End If
    
    .DrawGridLine 1, 3, iFixCols + iDataCols, iDataRows + 4 + 1, 0, 2, 0
    
    .SetColHidden 1, 1 '数量外币列隐藏
    If QcYue = "00" And j > 7 Then
       .SetColHidden 8, iFixCols + iDataCols - 1
    End If
    If strPrt <> "PRINT" Then
        .PrintPreview 1, 0
    Else
        .PrintSheet 1, 0
    End If
    .SaveFile App.Path + "\CellFiles\Kmyetz.cll", 0
End With
MousePointer = vbDefault
Me.Refresh
End Sub
'==========================有操作时调用该子程序===============
Private Function oOperate(strKey) As Boolean
    oOperate = True
    Select Case strKey
        Case "FIND"
              oLocateCol '定位行
        Case "PRINT"
            Call oPrintRec("PRINT")
        Case "PREVIEW"
            Call oPrintRec("PREVIEW")
       Case "TOTAL" '总账
              iZzMxOperate = 1
              Call pReCll
        Case "DETAIL" '明细
              iZzMxOperate = 2
              Call pReCll
        Case "AMOUNT" '数量操作
              iSlWbJeOperate = 1
              Call pReCll
        Case "FORING" '外币操作
              iSlWbJeOperate = 2
              Call pReCll
        Case "MONEY" '金额操作
              iSlWbJeOperate = 3
              Call pReCll
        Case "CALC"
              oCalcOperate True '平衡计算 并显示是否平衡窗体
        Case "DIRECT"
              oDirectOperate '方向操作
        Case "SAVE"
'         Dim rst10 As New ADODB.Recordset
'
'           With rst10
'                .Open "SELECT count(*) FROM tZW_pzsj" & glo.sOperateYear & _
'                        " WHERE xgbz='2' AND kjqj = 1", _
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -