来自「VB开发的ERP系统」· 代码 · 共 1,519 行 · 第 1/5 页

   Begin VB.Label tsLabel 
      AutoSize        =   -1  'True
      BackColor       =   &H80000018&
      BackStyle       =   0  'Transparent
      Caption         =   "期间损益结转"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   315
      Index           =   6
      Left            =   4095
      TabIndex        =   0
      Top             =   765
      Width           =   2085
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000FF&
      Index           =   0
      X1              =   3765
      X2              =   6416
      Y1              =   1110
      Y2              =   1110
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000FF&
      Index           =   1
      X1              =   3765
      X2              =   6416
      Y1              =   1140
      Y2              =   1140
   End
End
Attribute VB_Name = "AutoTran_DefiSy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************************************************
'*    模 块 名 称 :期间损益转帐凭证编辑
'*    功 能 描 述 :此功能模块主要完成期间损益转帐凭证的定义、修改、预览打印等。
'*    程序员姓名  : 姜冬梅
'*    最后修改人  : 姜冬梅
'*    开始设计时间：2001/1/10
'*    最后修改时间:
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'*    2.网格列存储内容注解
'*
'*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) "1"-浏览 "2"-新增 "3"-修改
'*
'*    4.Lab_Pzclzt 用此标签来标识凭证处理状态(默认值为1) "1"-填制凭证 "2"-查询凭证列表 "3"-审核凭证
'*
'*    5.原则:只要单据能够存盘(无论修改或新增)则其必须接受完整性及有效性规则检查
'*    6.期间损益科目的结转全部结转到本年利润
'*********************************************************************************************************
 
 '[以下为根据实际情况设置变量
    Dim Jsqte  As Long                              '临时计数器
    Dim Sqlstr As String                            '临时的SQL字符串
    Dim RecTemp As New ADODB.Recordset              '临时使用动态集
    Dim Rec_AutoAccItem As New ADODB.Recordset      '转帐项目记录集
    Dim TranClassCode As String                     '转帐类别编码
 ']
 
 '以下为固定使用变量(网格)
    Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
    Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
    Dim GridCode As String                          '显示网格网格代码
    Dim GridInf() As Variant                        '整个网格设置信息
    Dim ReportTitle As String                       '报表主标题
    Dim Tsxx As String                              '系统提示信息
    Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
    Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
    Dim Sfxshjwg As Boolean                         '是否显示合计网格
    Dim Qslz As Long                                '网格隐藏(非操作显示)列数
    Dim Sjhgd As Double                             '网格数据行高度
    Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
    Dim GridStr()  As String                        '网格列信息(字符型)
    Dim GridInt() As Integer                        '网格列信息(整型)
    Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
    Dim changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
    Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
    Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
    
    '以下为固定使用变量(文本框)
    Dim Textvar() As Variant                        '存储变体型文本框信息
    Dim Textboolean() As Boolean                    '存储布尔型文本框信息
    Dim Textint() As Integer                        '存储整型文本框信息
    Dim Textstr() As String                         '存储字符型文本框信息
    Dim Max_Text_Index As Integer                   '最大录入文本框索引值
    Dim TextGroupCode As String                     '文本框录入分组编码
    Dim TextValiLock As Boolean                     '文本框失去焦点是否进行有效性控制判断
    Dim TextValiJudgeLock() As Boolean              '文本框录入有效性判断控制锁,=True时光标离开不需要马上进行判断
    '=False时,即允许马上进行有效性验证。
    Dim CurTextIndex As Integer                     '当前文本框索引值
    Dim TextChangeLock As Boolean                   '文本框内容变换控制锁.=True时屏蔽LrText.Change事件，=False时则执行。
     '=True时，关闭Change事件，当新增记录填充网格、取消操作、按帮助按纽时均需关闭CHANGE事件。
    Dim Bln_Cancel As Boolean                       '取消按钮信息传递
    


Private Sub Form_KeyPress(KeyAscii As Integer)       '控 制 焦 点 转 移
    Dim jdzygs As Integer
    jdzygs = 10
    Select Case KeyAscii
    Case vbKeyReturn
        If Kjjdzy(jdzygs) Then
            KeyAscii = 0
        End If
    Case 39           '屏蔽字符"'"
        KeyAscii = 0
    End Select
End Sub

Private Sub Form_Load()                              '窗 体 装 入
    
    TranClassCode = AutoTran_TranList.TranClassCode
    '报表主标题及报表编码
    ReportTitle = "期间损益结转"
    XtReportCode = "Cwzz_AutoAccDefiMy"
    Load Dyymctbl
    
    '调 入 网 格
    GridCode = "Cwzz_AutoAccDefiSy "          '网格属性编码"
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
        WglrGrid.RowHeight(Jsqte) = Sjhgd
    Next Jsqte
    
    '填充收支方向
    Call FillCombo(CmbOut_In, "Cwzz_OutIn", "", 0)
    
    '调入文本框
    TextGroupCode = "Cwzz_AutoAccDefiSy"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    Call Cxnrtcwg
    
    
    '装入会计科目编码帮助窗体(为加快参照速度)PZ_FrmKjkmcz
    Load PZ_FrmKjkmcz
    Lab_OperStatus = 3
    
End Sub

Private Sub Cxnrtcwg()                               '查 询 内 容 填 充 网 格
    '读入凭证类别，转帐名称
    With AutoTran_TranList.CzxsGrid
        Lbl_AutoAccCode.Caption = .Tag
    End With
    Sqlstr = "SELECT Cwzz_AutoTranMain.VouchClassCode, Cwzz_VouchClass.VouchClassName, " & _
    " Cwzz_AutoTranMain.TranName , Cwzz_AutoTranMain.TranCode FROM Cwzz_AutoTranMain " & _
    "left OUTER JOIN Cwzz_VouchClass ON " & _
    "Cwzz_VouchClass.VouchClassCode = Cwzz_AutoTranMain.VouchClassCode where TranCode='" & Lbl_AutoAccCode.Caption & "' and TranClass='" & TranClassCode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    Lbl_AutoAccName.Caption = Trim(RecTemp.Fields("TranName"))
    Lbl_AutoAccClassCode.Caption = Trim(RecTemp.Fields("VouchClassCode"))
    Lbl_AutoAccClassName.Caption = Trim(RecTemp.Fields("VouchClassName"))
    RecTemp.Close
    '设置操作状态为浏览
    Lab_OperStatus.Caption = "1"
    
    '设置工具条状态
    Call Sub_OperStatus("11")
    
    '显示整张单据信息
    Call Sub_ShowBill
    '修改]
End Sub

Private Sub Wbkcsh()                          '录入文本框初始化
    
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
    
    ReDim TextValiJudgeLock(Max_Text_Index)
    For Jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
            TextChangeLock = True
            LrText(Jsqte).Text = ""
            LrText(Jsqte).Tag = ""
            If Textint(Jsqte, 5) <> 0 Then
                LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(Jsqte) = True
    Next Jsqte
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    '卸载打印页面窗体
    Unload Dyymctbl
    
    '卸载会计科目编码参照窗体
    PZ_FrmKjkmcz.UnloadCheck.Value = 1
    Unload PZ_FrmKjkmcz
    Set Rec_AutoAccItem = Nothing
    Set RecTemp = Nothing
End Sub

Private Sub Sub_ShowBill()                                          '根据当前单据号显示整张单据内容
    With WglrGrid
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
        For Jsqte = .FixedRows To .Rows - 1
            .RowHeight(Jsqte) = Sjhgd
        Next Jsqte
    End With
    Sqlstr = "SELECT Cwzz_AutoTranItem.TranClass, Cwzz_AutoTranItem.TranCode, " & _
    "Cwzz_AutoTranItem.Ccode, Cwzz_AutoTranItem.GetCcode," & _
    "Cwzz_AccCode1.Cname AS GetName, Cwzz_AccCode.Cname as Cname," & _
    "Cwzz_AutoTranItem.Digest, Cwzz_AutoTranItem.TranOri," & _
    "Cwzz_AutoTranItem.TranProp FROM Cwzz_AccCode Cwzz_AccCode1 RIGHT OUTER JOIN " & _
    "Cwzz_AutoTranItem ON Cwzz_AccCode1.Ccode = Cwzz_AutoTranItem.GetCcode LEFT OUTER JOIN " & _
    "Cwzz_AccCode ON Cwzz_AutoTranItem.Ccode = Cwzz_AccCode.Ccode LEFT OUTER JOIN " & _
    "Cwzz_AutoTranMain ON Cwzz_AutoTranItem.TranCode = Cwzz_AutoTranMain.TranCode AND " & _
    "Cwzz_AutoTranItem.TranClass = Cwzz_AutoTranMain.TranClass " & _
    "where Cwzz_AutoTranItem.TranCode='" & Lbl_AutoAccCode.Caption & "'" & _
    "and Cwzz_AutoTranItem.tranclass='" & TranClassCode & "' and Cwzz_AutoTranItem.FormulaCode<>'05'" & _
    " order by AutoTranId"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        WglrGrid.Clear 1
        If .EOF Then
            Exit Sub
        End If
        
        '[>>显示单据头
        Call Bill_Head_Show
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            If Jsqte >= WglrGrid.Rows Then
                WglrGrid.AddItem ""
            End If
            '[>>显示单据分录
            WglrGrid.TextMatrix(Jsqte, 0) = "*"
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Digest") & "")         '摘 要
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Ccode"))               '转帐科目编码
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Cname") & "")          '科目名称
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("TranOri") & "")        '转帐性质
            WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(LrText(1).Text)                 '利润科目
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(Lab_GetName.Caption)            '科目名称
            '<<]
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断,即在网格单元内录入数据时,点帮助信息等,不执行文本框等验证,即不执行YdText或YdCombo的LostFocus事件.
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    changelock = True
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "xg"                                            '修 改
        Call Sub_EditBill
    Case "Fill"                                         '填充关系
        Call Fill_Relation
    Case "bc"                                            '保 存
        Call Sub_SaveBill
    Case "fq"                                            '放 弃
        Call Sub_AbandonBill
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    '解 锁
    Valilock = False
    changelock = False
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作，更确切地讲，是工具栏热键
    If Shift = 2 Then   'Ctrl的位屏蔽值=2
        Select Case UCase(Chr(KeyCode))
        Case "P"                   'Ctrl+P 打印