VB开发的ERP系统

Dim TranJsq As Integer                   '本批选择的网格记录个数
Dim FiltListId() As Long                 '需要转帐的明细帐AccListID数组
Dim TranVouchClass() As String           '转帐凭证类别数组
Dim VouchModelType() As String           '凭证模板类型
Dim TranNoteCode() As String             '应收票据数据
Dim VouchRow As Long                     '每张凭证内分录的ID值

Dim Bln_DeleteFlag As Boolean            '转帐后是否删除临时表
Dim UnitFlag As Boolean                  '合并生成凭证标志
Dim ArApFlag As String                   '应收应付标志
Dim Int_Kjyear As Integer                '会计年
Dim Int_Period As Integer                '会计月

Dim MenuBillCode_Con As String           '转帐单据类型条件
Dim MenuBillCode As String               '菜单选中的单据类型


Dim YbJe As Double                       '原币金额
Dim BbJe As Double                       '本币金额

Dim AccRate As Double                    '记帐汇率
Dim BankBillNo As String                 '银行票号
Dim SsCode As String                     '结算方式
Dim ForeignCurrCode As String            '外币编码
Dim BillDate As Date                     '单据日期
Dim PersonName As String                 '经办人名称
Dim CustName As String                   '客户名称
Dim SuppName As String                   '供应商名称

Dim Rec As String                        '单据数据表名变量
Dim RecBillId As String                  '单据数据表ID


'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub CxbbGrid_DblClick()
    If CxbbGrid.Row > CxbbGrid.FixedRows - 1 And GridStr(CxbbGrid.Col, 1) = "001" Then
        If CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = "" Then
            If CxbbGrid.TextMatrix(CxbbGrid.Row, 1) = True Then
                 Tsxx = "该单据已制作凭证！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            If Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2)) <> 0 And Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("010", GridStr(), Szzls))) = "" Then
                 Tsxx = "该变动单对应的其它应收单没有审核！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            If Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 3)) <> 0 And Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("010", GridStr(), Szzls))) = "" Then
                 Tsxx = "该变动单对应的其它应付单没有审核！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = "√"
        Else
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = ""
        End If
    End If
End Sub

Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小(Fixed)
    
    On Error Resume Next
    
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140

End Sub

Private Sub Form_Load()                                                   '窗体装入
  
    '调入打印页面设置窗体
  
    '调整标题栏及网格、格式工具条位置(Fixed)
    Pic_Title.Left = 40
    Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
 
    '调 入 网 格(Fixed)
    GridCode = "Ar_NoteChList"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    MenuBillCode = ItemType
    ArApFlag = "AR"             '应收系统标志
    
 
    Call Start                  '初始化凭证类型、制单日期

End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载

    '卸载条件窗体
    PZ_FrmNoteChFilter.UnloadCheck.Value = 1
    Unload PZ_FrmNoteChFilter
End Sub

Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整(Fixed)
    
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(CxbbGrid, GridCode)
    End Select

End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "filter"                                        '过滤
            PZ_FrmNoteChFilter.Show 1
        Case "bill"                                          '单 据
            Call CxbbGrid_DblClick
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        Case "run"                                           '生成凭证
            Call Sub_Run
        Case "allselect"                                     '全选
            Call Sub_AllSelect
        Case "allcancel"                                     '全弃
            Call Sub_AllCancel
        Case "unit"                                          '合并
            Call Sub_Unit
    End Select
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
 
    '生成查询结果
    Call Sub_Query(0)
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

End Sub

Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim jsqte As Long                           '临时动态计数器
    Dim State As String                         '票据状态
    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With PZ_FrmNoteChFilter
         
            '生成查询条件
            Str_QueryCondi = " where 1=1  and " & MenuBillCode_Con
         
            For jsqte = 1 To 4
                Select Case jsqte
                    Case 1  '单据日期(起,止）
                        If Trim(.LrText(0).Text) <> "" And Trim(.LrText(1).Text) <> "" Then
                            If Trim(.LrText(0).Text) = Trim(.LrText(1)) Then
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate = '" & CDate(.LrText(0).Text) & "'"
                            Else
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate >= '" & CDate(.LrText(0).Text) & "'"
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate <= '" & CDate(.LrText(1).Text) & "'"
                            End If
                        End If
                        If Trim(.LrText(0).Text) <> "" And Trim(.LrText(1).Text) = "" Then
                            Str_QueryCondi = Str_QueryCondi & " and CloseDate >= '" & CDate(.LrText(0).Text) & "'"
                        End If
                        If Trim(.LrText(0).Text) = "" And Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and CloseDate <= '" & CDate(.LrText(1).Text) & "'"
                        End If
                    Case 2  '客户
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode = '" & Trim(.LrText(2).Tag) & "'"
                        End If
                    Case 3  '币别
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And ForeignCurrCode='" & Trim(.LrText(3).Tag) & "'"
                        End If
                    Case 4 '凭证状态
                        If .Opt_Check(1).Value = True Then '已制凭证
                            Str_QueryCondi = Str_QueryCondi & " And  IfBuildVouch='1' "
                        End If
                        If .Opt_Check(2).Value = True Then  '未制凭证
                            Str_QueryCondi = Str_QueryCondi & " And IfBuildVouch='0' "
                        End If
                        
                End Select
            Next jsqte
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2 "
        End If
    End If
    

    Sqlstr = "SELECT * FROM Ar_v_NoteClose " & Str_QueryCondi & "  Order By NoteCloseID"
    

    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, 0) = .Fields("NoteCloseID")                  '变动明细记录ID
            CxbbGrid.TextMatrix(jsqte, 1) = .Fields("IfBuildVouch")                 '是否已经生成凭证
            CxbbGrid.TextMatrix(jsqte, 2) = Trim(.Fields("BillIDAR") & "")          '应收单记录ID
            CxbbGrid.TextMatrix(jsqte, 3) = Trim(.Fields("BillIDAP") & "")          '付款单记录ID
            CxbbGrid.TextMatrix(jsqte, 4) = Trim(.Fields("VouchModel") & "")        '转帐凭证模板类型

            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = ""                                            '选中
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Format(.Fields("CloseDate"), "yyyy-mm-dd")    '单据日期
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillItemCode") & "")            '票据类型