frmac_detailselectprint2.frm

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

            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            If Val(glo.sOperateYear) > Val(.Fields("ModiYear").value) Then
                updMonthFrom.Tag = 1
            Else
                updMonthFrom.Tag = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), .Fields("BeginMonth").value, 1)
            End If
        End If
    End With
    
    '设置账页格式
     cboAccountFormat.AddItem "金额式"
     cboAccountFormat.AddItem "数量金额式"
     cboAccountFormat.AddItem "外币金额式"
     cboAccountFormat.AddItem "数量外币式"
     cboAccountFormat.ListIndex = 0
     If cboAccountFormat.ListIndex <> -1 Then
          usAccountFormat = cboAccountFormat.text
     Else
          usAccountFormat = ""
     End If
    usAccountFormat = "金额式"
    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
      
    '取当前登录时间为默认的年、月
    txtYear.text = Year(glo.sOperateDate)
    updMonthFrom.value = Month(glo.sOperateDate)
    updMonthTo.value = Month(glo.sOperateDate)
    
    With Cllr
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        If .OpenFile(App.Path & "\CellFiles\Detail.cll", "") = -1 Then
            MsgBox "CELL文件不存在！", vbOKOnly
        End If
          
     '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
      .ResetContent
      .SetDefaultFont .FindFontIndex("宋体", 1), 10
      .WorkbookReadonly = True
      .AllowSizeColInGrid = True

    End With
 m_bFormLoad = False
 Screen.MousePointer = vbDefault
  
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Cllr.Width = Me.ScaleWidth - 100
    Cllr.Height = Me.ScaleHeight - 200
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
    Unload Me
End Sub

Private Sub txtMonthFrom_Change()
    If Val(txtMonthFrom.text) > Val(txtMonthTo.text) Then
        txtMonthTo.text = txtMonthFrom.text
    End If
End Sub

Private Sub txtMonthFrom_GotFocus()
    txtMonthFrom.SelStart = 0
    txtMonthFrom.SelLength = Len(txtMonthFrom.text)
End Sub

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

Private Sub txtMonthFrom_Validate(Cancel As Boolean)
    If Val(txtMonthFrom.text) < 1 Or Val(txtMonthFrom.text) > 12 Then
        MsgBox "请输入一个合法的月份值！", vbExclamation
        Cancel = True
        txtMonthFrom.SelStart = 0
        txtMonthFrom.SelLength = Len(txtMonthFrom.text)
    End If
End Sub

Private Sub txtMonthTo_Change()
    If Val(txtMonthTo.text) < Val(txtMonthFrom.text) Then
        txtMonthFrom.text = txtMonthTo.text
    End If
End Sub

Private Sub txtMonthTo_GotFocus()
    txtMonthTo.SelStart = 0
    txtMonthTo.SelLength = Len(txtMonthTo.text)
End Sub

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

Private Sub txtMonthTo_Validate(Cancel As Boolean)
    If Val(txtMonthTo.text) < 1 Or Val(txtMonthTo.text) > 12 Then
        MsgBox "请输入一个合法的月份值！", vbExclamation
        Cancel = True
        txtMonthTo.SelStart = 0
        txtMonthTo.SelLength = Len(txtMonthTo.text)
    End If
End Sub


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





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

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

Private Sub txtSubjectend_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectEnd_Click
    End If
End Sub

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

Private Sub txtSubjectstart_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectStart_Click
    End If
End Sub

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

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

Private Sub updMonthFrom_Change()
    updMonthTo.Min = txtMonthFrom.text
End Sub

Private Function txt_kmcheck() As Boolean
     Dim iTemp As Integer
     Dim rstRec As New ADODB.Recordset
     Dim sSQL As String
     
  '起始科目代码是否在年度表中
    If txtSubjectStart.text <> "" Then
        iTemp = InStr(1, txtSubjectStart.text, "=")
        If iTemp <> 0 Then
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Left$(Trim$("" & txtSubjectStart.text), iTemp - 1) & "' "
        Else
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectStart.text) & "' "
        End If
        rstRec.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not (rstRec.EOF And rstRec.BOF) Then
           If iTemp <> 0# Then
                sKmCodeStart = Left$(Trim$("" & txtSubjectStart.text), iTemp - 1)
           Else
                sKmCodeStart = Trim$("" & txtSubjectStart.text)
           End If
        Else
             MsgBox "起始科目代码错误！", vbInformation
             txtSubjectStart.SelStart = 0
             txtSubjectStart.SelLength = Len(txtSubjectStart.text)
             txtSubjectStart.SetFocus
             Set rstRec = Nothing
             Exit Function
        End If
        rstRec.Close
    End If
  '终止科目代码是否在年度表中
   If txtSubjectEnd.text <> "" Then
        iTemp = InStr(1, txtSubjectEnd.text, "=")
        If iTemp <> 0 Then
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Left$(Trim$("" & txtSubjectEnd.text), iTemp - 1) & "' "
        Else
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectEnd.text) & "' "
        End If
        rstRec.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If Not (rstRec.EOF And rstRec.BOF) Then
           If iTemp <> 0# Then
                sKmCodeEnd = Left$(Trim$("" & txtSubjectEnd.text), iTemp - 1)
           Else
                sKmCodeEnd = Trim$("" & txtSubjectEnd.text)
           End If
        Else
             MsgBox "终止科目代码错误！", vbInformation
             txtSubjectEnd.SelStart = 0
             txtSubjectEnd.SelLength = Len(txtSubjectEnd.text)
             txtSubjectEnd.SetFocus
             Set rstRec = Nothing
             Exit Function
        End If
         rstRec.Close
         Set rstRec = Nothing
    End If
     '检查开始科目代码是否小于等于终止科目
    If sKmCodeStart <> "" Then
        If Trim(sKmCodeStart > sKmCodeEnd) Then
               MsgBox "起始科目编码要小于等于终止科目编码！", vbInformation
               txtSubjectStart.SetFocus
               txtSubjectStart.SelStart = 0
               txtSubjectStart.SelLength = Len(txtSubjectStart.text)
               txt_kmcheck = False
               Exit Function
         End If
    End If
   txt_kmcheck = True
End Function

Public Sub Kmmc_set()
   '设置科目代码数组
   Dim temp_code As String
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim iTemp As Integer
   Dim iLenStart As Integer
   Dim iLenEnd As Integer
   Dim sjcStart As Integer
   Dim sjcEnd As Integer
   Dim sTemp As String
   Dim sTempStart As String
   Dim sTempEnd As String
      
   '取科目代码
    j = 1
    iTemp = InStr(1, txtSubjectStart.text, "=")
    If iTemp <> 0 Then
       sKmCodeStart = Left$(Trim$("" & txtSubjectStart.text), iTemp - 1)
    Else
        sKmCodeStart = Trim$("" & txtSubjectStart.text)
    End If
    
    iTemp = InStr(1, txtSubjectEnd.text, "=")
    If iTemp <> 0 Then
        sKmCodeEnd = Left$(Trim$("" & txtSubjectEnd.text), iTemp - 1)
    Else
        sKmCodeEnd = Trim$("" & txtSubjectEnd.text)
    End If
   
   iLenStart = Len(sKmCodeStart)
   iLenEnd = Len(sKmCodeEnd)
       
    ReDim arySubDetail(0 To 0)
    j = 1

 
  '开始和终止代码都为空
    If sKmCodeStart = "" And sKmCodeEnd = "" Then
       sTemp = ""
       If GetDetailKm(sTemp) Then
          For i = LBound(arySubject) To UBound(arySubject)
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  arySubDetail(j).IsEndKm = arySubject(i).IsEndKm
                  j = j + 1
         Next i
       End If
       Exit Sub
    End If
    
   '开始科目为空和终止代码非空
   If sKmCodeStart <> "" And sKmCodeEnd = "" Then
       sTemp = sKmCodeStart
       If GetDetailKm(sTemp) Then
          For i = LBound(arySubject) To UBound(arySubject)
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  arySubDetail(j).IsEndKm = arySubject(i).IsEndKm
                  j = j + 1
         Next i
       End If