main.frm

应收款管理,管理收款项目和其他!

        .TextMatrix(0, 10) = "收款日期"
         .TextMatrix(0, 11) = "已付款"
        .TextMatrix(0, 12) = "业务员"
        .FixedRows = 1
     '设置各列对齐方式
     'For i = 0 To 3
     '   .ColAlignment(i) = 0
     'Next i
     '表头项居中
      '.FillStyle = flexFillRepeat
     ' .Col = 0
     ' .Row = 0
     ' .RowSel = 1
     ' .ColSel = .Cols - 1
     ' .CellAlignment = 4
     End With
'***************************************
sqltxt = "select * from jianbu where skrq <= #" & Date + 7 & "# and yf=false"
Set rst = ExecuteSQL(sqltxt, msgtxt)
If rst.RecordCount < 1 Then
MsgBox "没有查询到相应信息！", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If rst.EOF = False Then
    With eg1
    
     .Rows = 1
     Do While Not rst.EOF
       .Rows = .Rows + 1
       For i = 1 To rst.Fields.Count
           .TextMatrix(.Rows - 1, i) = rst.Fields(i - 1)
       Next i
      rst.MoveNext
     Loop
    End With
 End If
 rst.Close
 '******************************************************
 End Sub

Private Sub Command3_Click()
Picture2(3).ZOrder 0
Dim a As Integer
Dim i As Integer
   With eg2
        
       ' .CellType(1) = ctBoolean
        .ColWidth(0) = 500
        '.ColWidth(1) = 1000
        '.ColWidth(7) = 1000
       ' .ColWidth(10) = 2500
       ' .ColWidth(12) = 1800
        .Cols = 13
        .TextMatrix(0, 1) = "单号"
        .TextMatrix(0, 2) = "类别"
        .TextMatrix(0, 3) = "日期"
        .TextMatrix(0, 4) = "单位"
        .TextMatrix(0, 5) = "规格型号"
        .TextMatrix(0, 6) = "数量"
        .TextMatrix(0, 7) = "单价"
        .TextMatrix(0, 8) = "价值"
        .TextMatrix(0, 9) = "备注"
        .TextMatrix(0, 10) = "收款日期"
         .TextMatrix(0, 11) = "已付款"
         .TextMatrix(0, 12) = "业务员"
        .FixedRows = 1
     '设置各列对齐方式
     'For i = 0 To 3
     '   .ColAlignment(i) = 0
     'Next i
     '表头项居中
      '.FillStyle = flexFillRepeat
     ' .Col = 0
     ' .Row = 0
     ' .RowSel = 1
     ' .ColSel = .Cols - 1
     ' .CellAlignment = 4
     End With
'***************************************
sqltxt = "select * from jianbu where skrq <= #" & Date + 7 & "# and yf=false"
Set rst = ExecuteSQL(sqltxt, msgtxt)
If rst.RecordCount < 1 Then
MsgBox "没有查询到相应信息！", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If rst.EOF = False Then
    With eg2
    
     .Rows = 1
     Do While Not rst.EOF
       .Rows = .Rows + 1
       For i = 1 To rst.Fields.Count
           .TextMatrix(.Rows - 1, i) = rst.Fields(i - 1)
       Next i
      rst.MoveNext
     Loop
    End With
 End If
 rst.Close
 '******************************************************

End Sub

Private Sub Command4_Click()
Picture2(4).ZOrder 0
Dim a As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim s1 As Double
Dim s2 As Double
   With eg3(0)
   
       ' .CellType(1) = ctBoolean
        .ColWidth(0) = 500
        '.ColWidth(1) = 1000
        '.ColWidth(7) = 1000
       ' .ColWidth(10) = 2500
       ' .ColWidth(12) = 1800
        .Cols = 13
        .TextMatrix(0, 1) = "单号"
        .TextMatrix(0, 2) = "类别"
        .TextMatrix(0, 3) = "日期"
        .TextMatrix(0, 4) = "单位"
        .TextMatrix(0, 5) = "规格型号"
        .TextMatrix(0, 6) = "数量"
        .TextMatrix(0, 7) = "单价"
        .TextMatrix(0, 8) = "价值"
        .TextMatrix(0, 9) = "备注"
        .TextMatrix(0, 10) = "收款日期"
         .TextMatrix(0, 11) = "已付款"
         .TextMatrix(0, 12) = "业务员"
        .FixedRows = 1
     '设置各列对齐方式
     'For i = 0 To 3
     '   .ColAlignment(i) = 0
     'Next i
     '表头项居中
      '.FillStyle = flexFillRepeat
     ' .Col = 0
     ' .Row = 0
     ' .RowSel = 1
     ' .ColSel = .Cols - 1
     ' .CellAlignment = 4
     End With
'***************************************
sqltxt = "select * from jianbu"
Set rst = ExecuteSQL(sqltxt, msgtxt)
If rst.RecordCount < 1 Then
MsgBox "没有查询到相应信息！", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If rst.EOF = False Then
    With eg3(0)
    
     .Rows = 1
     Do While Not rst.EOF
       .Rows = .Rows + 1
       For i = 1 To rst.Fields.Count
           .TextMatrix(.Rows - 1, i) = rst.Fields(i - 1)
        
       Next i
      rst.MoveNext
     Loop
    End With
 End If
 rst.Close
 With eg3(0)
For j = 1 To eg3(0).Rows - 1
   If .TextMatrix(j, 10) <= Date + 7 And .TextMatrix(j, 11) = False Then
           .RowBackColor(j) = &HFF&
           End If
           Next
           End With
With eg3(0)

  For k = 1 To .Rows - 1
  s1 = Val(.TextMatrix(k, 6)) + s1
  s2 = Val(.TextMatrix(k, 8)) + s2
  
Next
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = "合计"
.TextMatrix(.Rows - 1, 6) = s1
.TextMatrix(.Rows - 1, 8) = s2
  End With
End Sub

Private Sub Command5_Click()
Picture2(5).ZOrder 0
End Sub

Private Sub CommandSCE1_Click()
Dim i As Integer
Dim sqltxt As String
Dim msgtxt As String
Dim mrc As ADODB.Recordset
sqltxt = "select * from jianbu where dh='" & text1(0).Text & "'"
Set mrc = ExecuteSQL(sqltxt, msgtxt)
If mrc.RecordCount > 0 Then
MsgBox "单号重复！", vbOKOnly + vbExclamation '"录入"
Exit Sub
End If
mrc.Close
For i = 0 To 6
If text1(i) = "" Then
MsgBox "信息录入不全！", vbOKCancel + vbExclamation, "录入"
Exit Sub
End If
Next
sqltxt = "select * from jianbu"
Set mrc = ExecuteSQL(sqltxt, msgtxt)
With mrc
.AddNew
.Fields(0) = text1(0).Text
.Fields(1) = Combo1(0).Text
.Fields(2) = DTP1.Value
.Fields(3) = text1(1).Text
.Fields(4) = text1(2).Text
.Fields(5) = text1(3).Text
.Fields(6) = text1(4).Text
.Fields(7) = text1(5).Text
.Fields(8) = text1(6).Text
.Fields(9) = DTP2.Value
.Fields(10) = Check4.Value
.Fields(11) = Combo1(1).Text
.Update
End With
For i = 1 To 6
text1(i) = ""
Next
text1(0).Text = text1(0).Text + 1
End Sub

Private Sub CommandSCE2_Click()
eg1.exportToExcel App.Path & "/msh1.xls", True
End Sub

Private Sub CommandSCE3_Click()
Dim sqltxt As String
Dim msgtxt As String
Dim mrc As ADODB.Recordset
sqltxt = "select * from jianbu where dh='" & eg2.TextMatrix(eg2.Row, 1) & "'"
Set mrc = ExecuteSQL(sqltxt, msgtxt)
mrc.Fields(10) = True
mrc.Update
mrc.Close
MsgBox "已修正成功！", vbOKOnly + vbExclamation, "修正"
End Sub

Private Sub CommandSCE4_Click(Index As Integer)
Dim a As Integer
Dim i As Integer
Dim l As Integer
Dim k As Integer
Dim s1 As Double
Dim s2 As Double
Dim j(5) As Boolean
'eg3(0).Clear
sqltxt = "select * from jianbu where "

If Check1(0).Value = 1 Then
  If Trim(Combo2.Text) = "" Then
   MsgBox "请输入月份！", vbOKOnly + vbExclamation, "查询"
  'cboItem(0).SetFocus
   Exit Sub
  Else
   j(0) = True
   If Combo2.Text = "01" Or Combo2.Text = "03" Or Combo2.Text = "05" Or Combo2.Text = "07" Or Combo2.Text = "08" Or Combo2.Text = "10" Or Combo2.Text = "12" Then
   sqltxt = sqltxt & "rq>= # 2004-" & Combo2.Text & "-01 # and rq<= # 2004-" & Combo2.Text & "-31 # "
  Else
  If Combo2.Text = "02" Then
   sqltxt = sqltxt & "rq>= # 2004-" & Combo2.Text & "-01 # and rq<= # 2004-" & Combo2.Text & "-29 # "
   Else
   sqltxt = sqltxt & "rq>= # 2004-" & Combo2.Text & "-01 # and rq<= # 2004-" & Combo2.Text & "-30 # "
  End If
  End If
  End If
End If
If Check2(0).Value = 1 Then
  If Trim(Text3(0).Text) = "" Then
   MsgBox "请输入单位名称！", vbOKOnly + vbExclamation, "查询"
   'cboItem(1).SetFocus
   Exit Sub
   Else
    j(1) = True
    If j(0) Then
      sqltxt = sqltxt & "and dw='" & Text3(0).Text & "'"
      Else
      sqltxt = sqltxt & "dw='" & Text3(0).Text & "'"
    End If
  End If
End If
If Check3(0).Value = 1 Then
  If Trim(Text4(0).Text) = "" Then
     MsgBox "请输入规格型号！", vbOKOnly + vbExclamation, "查询"
     'cboItem(2).SetFocus
     Exit Sub
    Else
      j(2) = True
      If j(0) Or j(1) Then
       sqltxt = sqltxt & "and ggxh='" & Text4(0).Text & "'"
       Else
       sqltxt = sqltxt & "ggxh='" & Text4(0).Text & "'"
      End If
   End If
End If
If Check5.Value = 1 Then
  If Trim(Combo3.Text) = "" Then
   MsgBox "请选择！", vbOKOnly + vbExclamation, "查询"
   'xtItem(3).SetFocus
   Exit Sub
  Else
   j(3) = True
   If j(0) Or j(1) Or j(2) Then
   sqltxt = sqltxt & "and yf=" & Combo3.Text
   Else
   sqltxt = sqltxt & "yf=" & Combo3.Text
  End If
  End If
  End If
  'If Not (j(0) Or j(1) Or j(2) Or j(3)) Then
  'MsgBox "请选择查询方式！", vbOKOnly + vbExclamation, "查询"
  'Exit Sub
'End If
If Check6.Value = 1 Then
  If Trim(Combo4.Text) = "" Then
   MsgBox "请输入业务员！", vbOKOnly + vbExclamation, "查询"
   'xtItem(3).SetFocus
   Exit Sub
  Else
   j(4) = True
   If j(0) Or j(1) Or j(2) Or j(3) Then
   sqltxt = sqltxt & "and yew= '" & Combo4.Text & "'"
   Else
   sqltxt = sqltxt & "yew='" & Combo4.Text & "'"
  End If
  End If
  End If
  If Not (j(0) Or j(1) Or j(2) Or j(3) Or j(4)) Then
  MsgBox "请选择查询方式！", vbOKOnly + vbExclamation, "查询"
  Exit Sub
End If
'Dim a As Integer
'Dim i As Integer
   With eg3(0)
        
       ' .CellType(1) = ctBoolean
        .ColWidth(0) = 500
        '.ColWidth(1) = 1000
        '.ColWidth(7) = 1000
       ' .ColWidth(10) = 2500
       ' .ColWidth(12) = 1800
        .Cols = 13
        .TextMatrix(0, 1) = "单号"
        .TextMatrix(0, 2) = "类别"
        .TextMatrix(0, 3) = "日期"
        .TextMatrix(0, 4) = "单位"
        .TextMatrix(0, 5) = "规格型号"
        .TextMatrix(0, 6) = "数量"
        .TextMatrix(0, 7) = "单价"
        .TextMatrix(0, 8) = "价值"
        .TextMatrix(0, 9) = "备注"
        .TextMatrix(0, 10) = "收款日期"
         .TextMatrix(0, 11) = "已付款"
         .TextMatrix(0, 12) = "业务员"
        .FixedRows = 1
     '设置各列对齐方式
     'For i = 0 To 3
     '   .ColAlignment(i) = 0
     'Next i
     '表头项居中
      '.FillStyle = flexFillRepeat
     ' .Col = 0
     ' .Row = 0
     ' .RowSel = 1
     ' .ColSel = .Cols - 1
     ' .CellAlignment = 4
     End With
'***************************************
'sqltxt = "select * from jianbu where skrq <= #" & Date + 7 & "# and yf=false"
Set rst = ExecuteSQL(sqltxt, msgtxt)
'On Error GoTo Error_Sql
If rst.RecordCount < 1 Then
MsgBox "没有查询到相应信息！", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If rst.EOF = False Then
    With eg3(0)
    
     .Rows = 1
     Do While Not rst.EOF
       .Rows = .Rows + 1
       For i = 1 To rst.Fields.Count
           .TextMatrix(.Rows - 1, i) = rst.Fields(i - 1)
        
       Next i
      rst.MoveNext
     Loop
    End With
 End If
 rst.Close
 With eg3(0)
For l = 1 To eg3(0).Rows - 1
   If .TextMatrix(l, 10) <= Date + 7 And .TextMatrix(l, 11) = False Then
           .RowBackColor(l) = &HFF&
           End If
           Next
           End With
With eg3(0)

  For k = 1 To .Rows - 1
  s1 = Val(.TextMatrix(k, 6)) + s1
  s2 = Val(.TextMatrix(k, 8)) + s2
  
Next
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = "合计"
.TextMatrix(.Rows - 1, 6) = s1
.TextMatrix(.Rows - 1, 8) = s2
  End With
 '******************************************************
End Sub

Private Sub CommandSCE5_Click(Index As Integer)
eg3(0).exportToExcel App.Path & "/msh1.xls", True
End Sub

Private Sub CommandSCE6_Click()
End
End Sub

Private Sub CommandSCE7_Click()
Dim sqltxt As String
Dim msgtxt As String
Dim mrc As ADODB.Recordset
sqltxt = "select * from yh where yh='" & Text5(0).Text & "'and mm='" & Text5(1).Text & "'"
Set mrc = ExecuteSQL(sqltxt, msgtxt)
If mrc.RecordCount < 1 Then
MsgBox "用户名和密码不正确！", vbOKOnly + vbExclamation, "系统"
Exit Sub
Else
mrc.Fields(0) = Text5(2).Text
mrc.Fields(1) = Text5(3).Text
mrc.Update
mrc.Close
MsgBox "修改成功！", vbOKOnly + vbExclamation, "系统"
End If
End Sub

Private Sub Form_Load()
Picture2(0).ZOrder 0
End Sub

Private Sub Picture1_Click()
Picture2(0).ZOrder 0
End Sub

Private Sub Text1_Change(Index As Integer)
text1(5).Text = Val(text1(3).Text) * Val(text1(4).Text)
End Sub