frmac_detailselectprint.frm

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

Private Sub cmdCancel_Click()
    Me.Hide
    Unload Me
    fMainForm.MousePointer = 0
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 Sub





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

Private Sub txtPrintStart_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then SendKeys "{tab}"
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) & "'" ' and isrjz=0"
        Else
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectStart.text) & "'" ' and isrjz=0"
        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) & "'" ' and isrjz=0"
        Else
            sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectEnd.text) & "'" ' and isrjz=0"
        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
                  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
                  j = j + 1
         Next i
       End If
       Exit Sub
    End If
     
   '开始科目为非空和终止代码空
    If sKmCodeStart = "" And sKmCodeEnd <> "" Then
       sTemp = ""
       iLenEnd = Len(sKmCodeEnd)
       If GetDetailKm(sTemp) Then
          For i = LBound(arySubject) To UBound(arySubject)
               If Left(arySubject(i).sSubjectCode, iLenEnd) <= Trim(sKmCodeEnd) Then
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  j = j + 1
               End If
         Next i
       End If
      Exit Sub
    End If
   
   
    '判断开始和终止代码是否是同一科目下
    '是
   
   iLenStart = Len(sKmCodeStart)
   iLenEnd = Len(sKmCodeEnd)
   
    If (GetRootParentKmdm(sKmCodeStart) = GetRootParentKmdm(sKmCodeEnd)) Then
       sTemp = GetRootParentKmdm(sKmCodeEnd)
       If GetDetailKm(sTemp) Then
          For i = LBound(arySubject) To UBound(arySubject)
               If Left(arySubject(i).sSubjectCode, iLenStart) >= Trim(sKmCodeStart) And Left(arySubject(i).sSubjectCode, iLenEnd) <= Trim(sKmCodeEnd) Then
                  ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                  arySubDetail(j).sSubjectCode = arySubject(i).sSubjectCode
                  arySubDetail(j).sSubjectName = arySubject(i).sSubjectName
                  j = j + 1
              End If
         Next i
       End If
     Else
     '不是同一级科目
         
         Call GetFKm(GetRootParentKmdm(sKmCodeStart), GetRootParentKmdm(sKmCodeEnd))
         For i = LBound(sFirstLevel) To UBound(sFirstLevel)
            sTemp = sFirstLevel(i).sSubjectCode
            If GetDetailKm(sTemp) Then
                For k = LBound(arySubject) To UBound(arySubject)
                   If Left(arySubject(k).sSubjectCode, iLenStart) >= Trim(sKmCodeStart) And Left(arySubject(k).sSubjectCode, iLenEnd) <= Trim(sKmCodeEnd) Then
                          ReDim Preserve arySubDetail(UBound(arySubDetail) + 1)
                          arySubDetail(j).sSubjectCode = arySubject(k).sSubjectCode
                          arySubDetail(j).sSubjectName = arySubject(k).sSubjectName
                          j = j + 1
                    End If
                Next k
            End If
         Next i
   End If
End Sub


Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long, Optional ByVal iPageStart As Integer = 0)
    Dim i As Long, j As Long
    Dim iAmountLen As Integer       '数量单位字符串的长度
    Dim iForeignlen As Integer      '外币单位字符串的长度
    Dim iPageNoLen As Integer       '页号字符串的长度
    Dim maxLen As Integer           '最大字符串的长度
    
    With Cllr
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .SetSelectMode PageNo - 1, 2
        .SetFixedCol COL_START, COL_BILL
        .SetFixedRow ROW_TITLE, ROW_HEAD2
    
'        .ShowSideLabel 0, PageNo - 1
'        .ShowTopLabel 0, PageNo - 1
        .SetDefaultRowHeight PageNo - 1, 1, 25.5
        If g_CH = -1 Then
            .SetDefaultRowHeight PageNo - 1, 1, 23