frmac_bookresultprint.frm

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

Const ROWS_PAGE = 30

Const COL_START = 1                 '开始列数
Const COL_SERIAL = 1                '序号
Const COL_MONTH = 2                 '月
Const COL_DAY = 3                  '日
Const COL_TYPE = 4                  '凭证种类
Const COL_NUMBER = 5                '凭证号码
Const COL_BILL = 6                  '单据号
Const COL_SUMMARY = 7               '摘要
Const COL_UNIT_PRICE = 8            '单价
Const COL_EXCHANGE_RATE = 9         '汇率
Const COL_DEBIT_AMOUNT = 10          '借方数量
Const COL_DEBIT_FOREIGN = 11         '借方外币
Const COL_DEBIT_MONEY = 12           '借方金额
Const COL_CREDIT_AMOUNT = 13        '贷方数量
Const COL_CREDIT_FOREIGN = 14       '贷方外币
Const COL_CREDIT_MONEY = 15         '贷方金额
Const COL_DIRECTION = 16            '方向
Const COL_BALANCE_AMOUNT = 17       '数量余额
Const COL_BALANCE_FOREIGN = 18      '外币余额
Const COL_BALANCE_MONEY = 19        '金额余额
Const COL_SEPARATE = 20             '分隔线
Const COL_MAN = 21                  '会计事项原处理人
Const COL_LOGOUT_YEAR = 22          '注销年
Const COL_LOGOUT_MONTH = 23         '注销月
Const COL_LOGOUT_DAY = 24           '注销日
Const COL_LOGOUT_TYPE = 25          '注销字
Const COL_LOGOUT_NUMBER = 26        '注销号
Const COL_END = 26                  '结束列

Const ROW_TITLE = 1                 '标题
Const ROW_ACCOUNTFORMAT = 2         '账页格式行
Const ROW_SUBJCODE = 3              '页眉科目代码
Const ROW_SUBJNAME = 4              '页眉科目名称
Const ROW_HEAD1 = 5                 '页标头行1
Const ROW_HEAD2 = 6                 '页标头行2
Const ROW_GRID_START = 7            '表格开始行

Const CRB_LINE = vbBlack

''金额式账页缺省列宽
'Const COLWIDTH_MONEY = "40,30,30,50,50,50,220,0,0,0,0,120,0,0,120,25,0,0,120,6,60,50,30,30,30,50"
'
''数量金额式账页缺省列宽
'Const COLWIDTH_AMOUNT = "40,30,30,50,50,50,220,100,0,120,0,120,120,0,120,25,120,0,120,6,60,50,30,30,30,50"
'
''外币金额式账页缺省列宽
'Const COLWIDTH_FOREIGN = "40,30,30,50,50,50,220,0,100,0,120,120,0,120,120,25,0,120,120,6,60,50,30,30,30,50"
'
''数量外币式账页缺省列宽
'Const COLWIDTH_AMOUNT_FOREIGN = "40,30,30,50,50,50,220,100,100,120,120,120,120,120,120,25,120,120,120,6,60,50,30,30,30,50"
'金额式账页缺省列宽
Const COLWIDTH_MONEY = "45,32,32,46,47,88,332,0,0,0,0,139,0,0,139,32,0,0,139,16,76,46,30,30,30,60"

'数量金额式账页缺省列宽
Const COLWIDTH_AMOUNT = "45,33,34,46,50,88,296,130,0,170,0,170,170,0,170,37,170,0,170,24,76,57,30,30,30,50"

'外币金额式账页缺省列宽
Const COLWIDTH_FOREIGN = "45,33,34,46,50,88,296,0,130,0,170,170,0,170,170,37,0,170,170,24,76,57,30,30,30,50"

'数量外币式账页缺省列宽
Const COLWIDTH_AMOUNT_FOREIGN = "45,33,34,46,50,88,296,130,130,170,170,170,170,170,170,37,170,170,170,24,76,57,30,30,30,50"


Dim dUnit_Price As Double           '单价
Dim dExchange_Rate As Double        '汇率

Dim gcJ As Double, gcD As Double        '过次页
Dim gcJSL As Double, gcDSL As Double
Dim gcJWB As Double, gcDWB As Double

Dim brhjJ As Double, brhjD As Double
Dim brhjJSL As Double, brhjJWB As Double
Dim brhjDSL As Double, brhjDWB As Double

Dim byhjJ As Double, byhjD As Double    '本月合计
Dim byhjJSL As Double, byhjJWB As Double
Dim byhjDSL As Double, byhjDWB As Double

Dim sFX As String                       '方向

Dim bnljJ As Double, bnljD As Double    '本年累计
Dim bnljJSL As Double, bnljJWB As Double
Dim bnljDSL As Double, bnljDWB As Double

Dim dYE As Double, dYESL As Double, dYEWB As Double

Dim sbyFX As String                 '本月合计余额方向
Dim sbyYE As Double                 '本月合计余额
Dim CurRow As Long                  '存放当前行的行数(从表格开始行计数)
Dim lCount As Long                  '数据行的行数(从数据行开始计数)
Dim lPage As Long                   '当前所在页

Dim m_sYear As String               '查账年份
Dim m_sFromDate As String           '查询开始日期
Dim m_sToDate As String             '查询截止日期
Dim m_sFromMonth As String          '查账起始月
Dim m_sToMonth As String            '查账截止月
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_sMonthFrom As String, m_sMonthTo As String                        '查询起始月份、截止月份
Dim m_sMaxEndMonth As String                                            '查询最小月份、查询最大月份

Dim m_sSubjectCode() As String
Dim m_sSubjectName() As String
Dim m_stemp() 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    '当前账页的缺省列宽
Private m_iPrintedPages As Long          '已经打印的页数
'------------------------------------------------------------
Private Type udtKm
    sSubjectCode As String
    sSubjectName As String
    IsEndKm As Boolean
End Type
'Dim CSubject  As clsSubjects
Dim sKmCodeStart As String
Dim sKmCodeEnd As String
Dim bpzFlag As Boolean
Dim iMaxDay As Integer
Dim sFirstLevel() As udtKm   '存放一级科目代码范围
Dim arySubject() As udtKm          '存放明细科目名称范围
Dim arySubDetail() As udtKm
Dim m_bMjFlag As Boolean            '存放末级标志
'----------------------------------------
'设置打印科目代码和名称
Dim m_sPrintSubjectCode As String
Dim m_sPrintSubjectName As String
Dim m_sDaySubjectName As String
Dim m_sDdaySubjectCode As String

'-----------------------------------------
Public usAccountType As String      '账页类型
Public usAccountFormat As String    '账页格式

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

End Sub

Private Sub cboMonthFrom_Click()
    Dim i As Integer
    Dim sTxt As String
    
    '查询起始月改变时, 先保存查询截止月的内容, 然后重新填充截止月列表框;
    sTxt = IIf(cboMonthTo.text = "", 0, cboMonthTo.text)
    cboMonthTo.Clear
    For i = cboMonthFrom.ListIndex + m_sMonthFrom + 1 To 12
        cboMonthTo.AddItem glo.sOperateYear & "." & i
    Next i
    If CInt(Mid(sTxt, InStr(1, sTxt, ".") + 1)) < CInt(Mid(cboMonthFrom.text, InStr(1, cboMonthFrom.text, ".") + 1)) Then
        cboMonthTo.text = cboMonthFrom.List(cboMonthFrom.ListIndex)
    Else
        For i = 0 To cboMonthTo.ListCount - 1
            If cboMonthTo.List(i) = sTxt Then
                cboMonthTo.ListIndex = i
                Exit For
            End If
        Next i
    End If
End Sub

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

End Sub

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

End Sub

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

End Sub

Private Sub cboSubjectStart_Click()
  Dim i As Integer
   cboSubjectEnd.Clear
   If cboSubjectStart.ListIndex <> -1 Then
      For i = cboSubjectStart.ListIndex To cboSubjectStart.ListCount - 1
          cboSubjectEnd.AddItem m_stemp(i)
      Next i
   End If
  cboSubjectEnd.ListIndex = -1

End Sub

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

End Sub



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

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdpreview_Click()
    Dim i As Integer
   Dim iTemp As Integer
   If Printers.Count = 0 Then
        MsgBox "请安置打印机！", vbInformation
        Exit Sub
   End If
    Screen.MousePointer = 11
   If cboSubjectStart.ListIndex = -1 Or cboSubjectEnd.ListIndex = -1 Then
           MsgBox "请填写进行查询的科目！", vbInformation
           Screen.MousePointer = vbDefault
       Exit Sub
   End If
  
   Call Kmmc_set
        
  m_sYear = glo.sOperateYear
  If opt_day.value Then
        m_sFromDate = DtpDayFrom.value
        m_sToDate = DtpDayTo.value
        m_sFromMonth = Format(Month(DtpDayFrom.value), "00")
        m_sToMonth = Format(Month(DtpDayTo.value), "00")
  End If
  If Opt_month.value Then
       iTemp = InStr(1, cboMonthFrom.text, ".")
       m_sFromDate = Left$(cboMonthFrom.text, iTemp - 1) + "-" + Format(Mid$(cboMonthFrom.text, iTemp + 1), "00") + "-01"
       m_sFromMonth = Format(Mid$(cboMonthFrom.text, iTemp + 1), "00")
       iTemp = InStr(1, cboMonthTo.text, ".")
       m_sToMonth = Format(Mid$(cboMonthTo.text, iTemp + 1), "00")
       
       If m_sToMonth = 12 Then
         iMaxDay = 31
       Else
        iMaxDay = DateDiff("d", glo.sOperateYear & "-" & Format(m_sToMonth, "00") & "-01", _
                                glo.sOperateYear & "-" & Format(m_sToMonth + 1, "00") & "-01")
      End If
      m_sToDate = Left$(cboMonthTo.text, iTemp - 1) + "-" + Format(m_sToMonth, "00") + "-" + CStr(iMaxDay)
       
  End If
  
   m_sSubjCode = arySubDetail(1).sSubjectCode
   m_sSubjName = arySubDetail(1).sSubjectName

   Call ShowResult
   
   If Not bpzFlag Then
     Call uPreview
   End If
   Screen.MousePointer = vbDefault
End Sub

Private Sub DtpDayFrom_Change()
   DtpDayTo.MinDate = DtpDayFrom.value
   
End Sub

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

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

End Sub

Private Sub form_load()
   Dim rstTemp As ADODB.Recordset
   Dim rSt As ADODB.Recordset
   Dim i As Integer
   Dim sSQL As String
      
   DtpDayFrom.MaxDate = Format(glo.sOperateYear + "-12" + "-31", "yyyy-mm-dd")
   DtpDayFrom.MinDate = Format(glo.sOperateYear + "-01" + "-01", "yyyy-mm-dd")
   DtpDayTo.MaxDate = Format(glo.sOperateYear + "-12" + "-31", "yyyy-mm-dd")
   DtpDayTo.MinDate = DtpDayFrom.value
   
   
   '装入所有日记账科目
   i = 0
    Set rSt = New ADODB.Recordset
    rSt.CursorLocation = adUseClient