˪-i

VB开发的ERP系统

          MsgBox "显示单据详细信息(调用采购发票处理窗体)!"
      Case "jz"                                            '过 帐
        Call Sub_Sxfpgz
      Case "cx"                                            '查询
        ApNote_FrmFpgzcxtj.Show
      Case "bz"                                            '帮 助
        Call F1bz
      Case "fh"                                            '退 出
       Unload Me
   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                           '临时动态计数器
    
    '以下为自定义部分[
    
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
    
        With ApNote_FrmFpgzcxtj
            
            '生成查询条件
            Str_QueryCondi = " Where 1=1 "
            
            For Jsqte = 1 To 3
                Select Case Jsqte
                    Case 1  '查询日期范围(起始)
                        If Trim(.LrText(0).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.InvoiceDate>=' " & Trim(.LrText(0).Text) & "'"
                        End If
                    Case 2  '查询日期范围(终止)
                        If Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.InvoiceDate<= ' " & Trim(.LrText(1).Text) & "'"
                        End If
                    Case 3  '供应商
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and a.SupplierCode = '" & Trim(.LrText(2).Tag) & "'"
                        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 a.*,Gy_Person.PersonName,Gy_Supplier.SupplierName,Gy_ForeignCurrency.ForeignCurrName" & _
             " FROM Cg_InvoiceMain a LEFT OUTER JOIN " & _
             " Gy_Supplier ON a.SupplierCode = Gy_Supplier.SupplierCode LEFT OUTER JOIN " & _
             " Gy_Person ON a.PersonCode = Gy_Person.PersonCode LEFT OUTER JOIN " & _
             " Gy_ForeignCurrency ON a.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode " & Str_QueryCondi & " And InvoiceFlag=1 And ApBookFlag=0 And Checker<>''  Order By InvoiceDate,InvoiceNum"
    
    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("InvoiceMainID")                                                 '发票主表ID
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = False                                        '选中
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Format(.Fields("InvoiceDate"), "yyyy-mm-dd") '单据日期
            If Trim(.Fields("InvoiceSort") & "") = 0 Then
                CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "普通发票"                               '普通发票
            Else
                CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "专用发票"                               '专用发票
            End If
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("InvoiceNum") & "")             '发票号
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("SupplierName") & "")           '供应商
            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")        '币别
            If .Fields("NowValueFor") <> 0 Then                                                                      '原币金额
               CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("NowValueFor")
            End If
            If .Fields("NowValue") <> 0 Then                                                                         '本币金额
               CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("NowValue")
            End If
            CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")             '业务员
            CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("Maker") & "")                  '制单人
            CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("Checker") & "")                '审核人
            
            
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
            
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
            
        Loop
        
        '<<]
            
            
    End With
    
    ']以上为用户自定义部分
    
End Sub

'====================================以下为单据选中操作======================================'
Private Sub CxbbGrid_DblClick()                         '双击切换
   With CxbbGrid
     If .Row < .FixedRows Then
       Exit Sub
     End If
     If CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) Then
        CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = False
     Else
        CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = True
     End If
  End With
End Sub
Private Sub CxbbGrid_KeyPress(KeyAscii As Integer)      '用户按空格表示切换,按回车表示选中
   With CxbbGrid
     If Chr(KeyAscii) = " " Then
        For Jsqte = .Row To .RowSel
          If CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) Then
             CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = False
          Else
             CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = True
          End If
        Next Jsqte
     End If
     
     If KeyAscii = vbKeyReturn Then
        For Jsqte = .Row To .RowSel
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = True
        Next Jsqte
     End If
     
   End With
End Sub
Private Sub Sub_SelectAll()                             '全选
  With CxbbGrid
    For Jsqte = .FixedRows To .Rows - 1
        CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = True
    Next Jsqte
  End With
End Sub
Private Sub Sub_AbandonAll()                            '全消
  With CxbbGrid
    For Jsqte = .FixedRows To .Rows - 1
        CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = False
    Next Jsqte
  End With
End Sub
'====================================以上为单据选中操作======================================'

Private Sub Sub_Sxfpgz()                                '赊销发票过帐
  Dim RecTemp As New ADODB.Recordset      '临时使用动态集
  Dim Jsqte As Long
  Dim Lng_Fpjsq As Long        '选中发票计数器
  Dim Int_Dqyear As Integer    '用户选择会计年度
  Dim Int_DqPeriod As Integer  '用户选择会计期间
  Dim Lng_BillID As Long       '单据标识
  Dim yhAnswer As Integer      '回答是否确认
  
  '判断用户选中发票张数
  Lng_Fpjsq = 0
  For Jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
    If CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) Then
       Lng_Fpjsq = Lng_Fpjsq + 1
    End If
  Next Jsqte
   
  If Lng_Fpjsq = 0 Then
     Tsxx = "请先选中过帐发票!"
     Call Xtxxts(Tsxx, 0, 4)
     Exit Sub
  End If
     
     
  '判断用户所选业务日期与当前会计期间是否一致
  Sqlstr = "Select Top 1 * FROM Gy_Kjrlb Where ApJzbz=0 Order By Kjyear,Period"

  Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

  With RecTemp
    If Not .EOF Then
       If Not (Xtrq >= .Fields("Qsrq") And Xtrq <= .Fields("Zzrq")) Then
          Tsxx = "业务日期应在当前会计期间范围内!"
          Call Xtxxts(Tsxx, 0, 4)
          Exit Sub
       Else
          Int_Dqyear = .Fields("Kjyear")
          Int_DqPeriod = .Fields("Period")
       End If
    Else
       Tsxx = "所有会计期间已结帐完毕!"
       Call Xtxxts(Tsxx, 0, 4)
       Exit Sub
    End If
  End With

  '让用户确认是否过帐选中发票
  
  Tsxx = "请确认是否将选中发票过帐到" & Mid(Trim(Str(10000 + Int_Dqyear)), 2, 4) & "." & Mid(Trim(Str(100 + Int_DqPeriod)), 2, 2) & "会计期间?"
  yhAnswer = Xtxxts(Tsxx, 2, 2)
  If yhAnswer = 2 Then
     Exit Sub
  End If
  
  '采购发票过帐
  For Jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
    If CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) Then
       Lng_BillID = Val(CxbbGrid.TextMatrix(Jsqte, 0))
       If Not Fun_AccInvoiceBill(Lng_BillID, Int_Dqyear, Int_DqPeriod) Then
          Exit Sub
       End If
    End If
  Next Jsqte
  
  '过帐完毕,刷新网格
  Xt_Wait.Show
  Xt_Wait.Refresh
   
  '加快显示速度
  CxbbGrid.Redraw = False
 
  '生成查询结果
  Call Sub_Query(1)
   
  CxbbGrid.Redraw = True
    
  Xt_Wait.Hide
  
  Tsxx = "采购发票过帐完毕!"
  Call Xtxxts(Tsxx, 0, 4)
  
End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  Bbbwhgs = 0                                          '报 表 表 尾 行 数
  ReDim Bbxbt(1 To Bbxbtgs)
  ReDim bbxbtzzxs(1 To Bbxbtgs)
  If Bbbwhgs <> 0 Then
     ReDim Bbbwh(1 To Bbbwhgs)
     ReDim Bbbwhzzxs(1 To Bbbwhgs)
  End If
  Bbzbt = ReportTitle
  Bbxbt(1) = " "
  bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  Call Scyxsjb(CxbbGrid)                               '生成报表数据
  Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  If Not bbylte Then
     Unload DY_Tybbyldy
  End If
End Sub