frmac_generalselectprint.frm

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

''金额式账页缺省列宽
'Const COLWIDTH_MONEY = "30,30,200,0,0,100,0,0,100,30,0,0,125"
'
''数量金额式账页缺省列宽
'Const COLWIDTH_AMOUNT = "30,30,200,100,0,100,100,0,100,30,100,0,125"
'
''外币金额式账页缺省列宽
'Const COLWIDTH_FOREIGN = "30,30,200,0,100,100,0,100,100,30,0,100,125"
'
''数量外币式账页缺省列宽
'Const COLWIDTH_AMOUNT_FOREIGN = "30,30,200,100,100,100,100,100,100,30,100,100,125"
'金额式账页缺省列宽
Const COLWIDTH_MONEY = "32,32,332,0,0,139,0,0,139,32,0,0,139"

'数量金额式账页缺省列宽
Const COLWIDTH_AMOUNT = "33,32,332,170,0,170,170,0,170,37,170,0,170"

'外币金额式账页缺省列宽
Const COLWIDTH_FOREIGN = "33,32,332,170,170,0,170,170,37,0,170,170"

'数量外币式账页缺省列宽
Const COLWIDTH_AMOUNT_FOREIGN = "33,32,332,170,170,170,170,170,170,37,170,170,170"

Dim m_iYear As Integer              '查询年份
Dim m_iFromMonth As Integer         '查询开始月份
Dim m_iToMonth As Integer           '查询截止月份
Dim m_sSubjCode As String           '科目代码
Dim m_sSubjName As String           '科目名称
Dim m_sEnterName As String          '单位名称
Dim m_sSldw As String               '数量单位
Dim m_sWbdw As String               '外币单位

Dim m_bAmount As Boolean            '是否数量账
Dim m_bForeign As Boolean           '是否外币账
Dim m_bFormLoad As Boolean          '是否在窗体引导状态
Dim m_bExistRecord As Boolean       '是否存在记录

Dim m_iCol As Integer               '鼠标右击单元格所在行
Dim m_iRow As Integer               '鼠标右击单元格所在列
Dim m_iColWidth() As Integer        '存放表格各列的宽度
Dim m_iColWidthTemp() As Integer    '存放表格列宽被修改后的宽度
Dim m_sDefaultColWidth As String    '当前账页的缺省列宽

Public usAccountType As String      '账页类型
Public usAccountFormat As String    '账页格式
Public ubHappen As Boolean          '是否有发生
'----------------------------------------------
Private Type udtKm
    sSubjectCode As String
    sSubjectName As String
End Type

Dim sFirstLevel() As udtKm   '存放一级科目代码范围
Dim arySubject() As udtKm          '存放明细科目名称范围
Dim arySubDetail() As udtKm
Dim sKmCodeStart As String
Dim sKmCodeEnd As String
Dim bDetailFlag As Boolean    '明细标志

'----------------------------------------
Dim m_sPrintSubjectName As String
Dim m_sPrintSubjectCode As String
Dim m_sGenSubjectCode As String
Dim m_sGenSubjectName As String

'----------------------------------------
Dim sKmStart As udtKm
Dim sKmEnd   As udtKm

Dim m_sMjvalue     As String
Dim m_sJsStart As String    '定义起始级科目
Dim m_sJsEnd As String      '定义终止级科目

Dim CSubject As clsSubject

Dim IsSyTitle As Boolean  '是否显示明细账

Private Sub cboAccountFormat_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then SendKeys "{tab}"
End Sub





Private Sub chkEndLevelSubject_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
        SendKeys "{tab}"
    
    End If
End Sub

Private Sub ChkMj_Click()
  If ChkMj.value = 1 Then
    '  txtJcFrom.Enabled = False
      txtJcTo.Enabled = False
    '  updJcFrom.Enabled = False
      updJcTo.Enabled = False
   Else
    '  txtJcFrom.Enabled = True
      txtJcTo.Enabled = True
    '  updJcFrom.Enabled = True
      updJcTo.Enabled = True
   End If
End Sub

Private Sub ChkMj_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then SendKeys "{tab}"
End Sub


Private Sub chkMode_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
        SendKeys "{tab}"
    
    End If
End Sub


Private Sub chkNoHappen_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
        SendKeys "{tab}"
    
    End If
End Sub

Private Sub cmdHelp_Click()
   
   Call ShowHelp
End Sub

Private Sub cmdpreview_Click()
   Dim i As Integer
    If SqlStringValid(txtSubjectStart.text) = False Then
        MsgBox "起始科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
    If SqlStringValid(txtSubjectEnd.text) = False Then
        MsgBox "终止科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
   If IsNumeric(txtPageStart) = False Then MsgBox "请在起始页号输入数字!", vbInformation, "提示": Exit Sub
  'brb  add****
   If Printers.Count = 0 Then
        MsgBox "请安置打印机！", vbInformation
        Exit Sub
  End If
   'end*****
   If Not txt_kmcheck Then
      Exit Sub
   End If
   'set start and end jc
   m_sJsStart = txtJcFrom.text
   m_sJsEnd = txtJcTo.text
         
   Call Kmmc_set
   If LBound(arySubDetail) = 0 And UBound(arySubDetail) = 0 Then
      MsgBox "没有否合条件的科目", vbInformation
      Exit Sub
   End If
   If chkMode.value = 0 Then
        m_sSubjCode = arySubDetail(1).sSubjectCode
        m_sSubjName = arySubDetail(1).sSubjectName
        Call ShowResult(CInt(txtPageStart) - 1)
        Call uPreview
   Else
        Dim kmdm() As String
        Dim Kmmc() As String
        ReDim kmdm(UBound(arySubDetail))
        ReDim Kmmc(UBound(arySubDetail))
        For i = LBound(arySubDetail) To UBound(arySubDetail)
            kmdm(i) = arySubDetail(i).sSubjectCode
            Kmmc(i) = arySubDetail(i).sSubjectName
        Next i
        Load frmAC_GeneralModePrint
        frmAC_GeneralModePrint.CopyKmArray kmdm, Kmmc
        frmAC_GeneralModePrint.uModePreview CInt(txtPageStart) - 1
   End If
End Sub

Private Sub cmdPrint_Click()
   Dim i As Integer
   Dim iPageStart As Integer
    If SqlStringValid(txtSubjectStart.text) = False Then
        MsgBox "起始科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
    If SqlStringValid(txtSubjectEnd.text) = False Then
        MsgBox "终止科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
   If IsNumeric(txtPageStart) = False Then MsgBox "请在起始页号输入数字!", vbInformation, "提示": Exit Sub
   'brb  add****
   If Printers.Count = 0 Then
           MsgBox "请安置打印机！", vbInformation
           Exit Sub
  End If
   'end*****
   If Not txt_kmcheck Then
      Exit Sub
   End If
  'set start and end jc
   If ChkMj.value = 1 Then
       m_sJsStart = Trim(txtJcFrom.text)
       m_sJsEnd = Trim(txtJcTo.text)
   Else
       m_sJsStart = "1"
       m_sJsEnd = m_sMjvalue
   End If
   
   Call Kmmc_set
   If LBound(arySubDetail) = 0 And UBound(arySubDetail) = 0 Then
      Exit Sub
      MsgBox "没有符合条件的科目！", vbInformation
   End If
   i = 1
   Screen.MousePointer = 11
   iPageStart = CInt(txtPageStart) - 1
   If chkMode.value = 1 Then
        Dim kmdm() As String
        Dim Kmmc() As String
        ReDim kmdm(UBound(arySubDetail))
        ReDim Kmmc(UBound(arySubDetail))
        For i = LBound(arySubDetail) To UBound(arySubDetail)
            kmdm(i) = arySubDetail(i).sSubjectCode
            Kmmc(i) = arySubDetail(i).sSubjectName
        Next i
        Load frmAC_GeneralModePrint
        frmAC_GeneralModePrint.ubIncludeNoHappen = (chkNoHappen.value <> 0)
        frmAC_GeneralModePrint.CopyKmArray kmdm, Kmmc
        frmAC_GeneralModePrint.uModePrint iPageStart
   Else
         For i = 1 To UBound(arySubDetail)
             m_sSubjCode = arySubDetail(i).sSubjectCode
             m_sSubjName = arySubDetail(i).sSubjectName
             iPageStart = ShowResult(iPageStart)
             If chkNoHappen.value <> 0 Then
                udoPrint
             Else
                If ubHappen = True Then
                    udoPrint
                End If
             End If
        Next i
   End If
  Screen.MousePointer = vbDefault
End Sub

Private Sub cmdSubjectEnd_Click()
     With frmUSU_GeneralKmHelp
         .usCondition = " kmjc<>0"
         .ubSelAll = True
         .Show 1
        If .Valid Then
            txtSubjectEnd.text = .SubjectCode & "=" & .SubjectName
        End If
    End With
    End Sub

Private Sub cmdSubjectStart_Click()
   With frmUSU_GeneralKmHelp
         .usCondition = " kmjc<>0"
         .ubSelAll = True
         .Show 1
        If .Valid Then
            txtSubjectStart.text = .SubjectCode & "=" & .SubjectName
        End If
    End With
End Sub

Private Sub Form_Initialize()
IsSyTitle = False
End Sub

Private Sub form_load()
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim i As Integer
    
    Set CSubject = New clsSubject
    m_bFormLoad = True
    
    chkEndLevelSubject.value = False
    '设置最大的科目级次
    m_sMjvalue = uGetMaxJc
    updJcFrom.Max = CInt(m_sMjvalue)
    updJcFrom.value = 1
    updJcFrom.Min = 1
    updJcFrom.Increment = 1
    txtJcFrom.text = 1
    
    updJcTo.Max = CInt(m_sMjvalue)
    updJcTo.Min = 1
    updJcTo.Increment = 1
    updJcTo.value = 1 'CInt(m_sMjvalue)
    txtJcTo.text = 1 'CInt(m_sMjvalue)
    
    
     cboAccountFormat.AddItem "金额式"
     cboAccountFormat.AddItem "数量金额式"
     cboAccountFormat.AddItem "外币金额式"
     cboAccountFormat.AddItem "数量外币式"
     cboAccountFormat.ListIndex = 0
     If cboAccountFormat.ListIndex <> -1 Then
          usAccountFormat = cboAccountFormat.text
     Else
          usAccountFormat = ""
     End If
              
    usAccountType = "总 账"
    Select Case usAccountFormat
        Case "金额式"
            m_sDefaultColWidth = COLWIDTH_MONEY
        Case "数量金额式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT
        Case "外币金额式"
            m_sDefaultColWidth = COLWIDTH_FOREIGN
        Case "数量外币式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT_FOREIGN
    End Select
   '求出各列的宽度
    'm_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
    m_iColWidth = ToIntegerArray(m_sDefaultColWidth)
    m_iColWidthTemp = m_iColWidth
    Cllr.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
    If Cllr.OpenFile(App.Path & "\CellFiles\Detail.cll", "") = -1 Then
        MsgBox "CELL文件不存在！", vbOKOnly
    End If