mainfrm.frm

前几年我用VB写的一个烟草访销日结算系统,实现了一种VB中动态报表的生成方案

      Begin VB.Label Label9 
         BackStyle       =   0  'Transparent
         Caption         =   "用户队别："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   300
         TabIndex        =   9
         Top             =   435
         Width           =   1215
      End
      Begin VB.Label Label4 
         Caption         =   "订购数量："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   300
         TabIndex        =   6
         Top             =   2415
         Width           =   1305
      End
      Begin VB.Label Label3 
         Caption         =   "香烟品名："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   330
         TabIndex        =   4
         Top             =   1725
         Width           =   1200
      End
      Begin VB.Label Label2 
         Caption         =   "零售户姓名："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   1020
         Width           =   1455
      End
   End
   Begin VB.Label Label16 
      Caption         =   "2001年9月3日"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   10200
      TabIndex        =   34
      Top             =   480
      Width           =   1455
   End
   Begin VB.Label Label15 
      Caption         =   "作者：裴凌翔"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   8640
      TabIndex        =   33
      Top             =   480
      Width           =   1575
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "烟草访销结算系统"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   525
      Left            =   3375
      TabIndex        =   0
      Top             =   105
      Width           =   4335
   End
End
Attribute VB_Name = "MainFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As CDTFpublic.MyAdoclass
Dim rs As ADODB.Recordset
Dim vtemp(3) As String
Dim vhead(5) As String


Private Sub cboCigarette_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtSaleNum.SetFocus
        txtSaleNum.SelStart = 0
        txtSaleNum.SelLength = Len(Trim(txtSaleNum.Text))
    End If
End Sub

Private Sub cboCustomer_Click()
        If Trim(cboCustomer.Text) = "" Then
            Exit Sub
        End If
        If Check1.value = 1 Then
        conn.Query_RsStatic rs, "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.customerid))=" & Trim(Left(cboCustomer.Text, 3)) & " and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        cdtfMainGrid.ClearData
        cdtfMainGrid.IniListviewData rs, 3
        conn.Query_RsStatic rs, "select sum(b.ordernum) as sumOrder ,sum(b.ordernum*c.xyjg) as totalMoney from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.customerid))=" & Trim(Left(cboCustomer.Text, 3)) & " and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        If rs.Fields(0) <> 0 Then
            Label11.Caption = rs.Fields(0)
            Label13.Caption = rs.Fields(1)
        Else
            Label11.Caption = ""
            Label13.Caption = ""
        End If
        cboCustomer.SetFocus
    Else
        conn.Query_RsStatic rs, "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21) and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        cdtfMainGrid.ClearData
        cdtfMainGrid.IniListviewData rs, 3
        conn.Query_RsStatic rs, "select sum(b.ordernum) as sumOrder ,sum(b.ordernum*c.xyjg) as totalMoney from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21) and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        If rs.Fields(0) <> 0 Then
            Label11.Caption = rs.Fields(0)
            Label13.Caption = rs.Fields(1)
        Else
            Label11.Caption = ""
            Label13.Caption = ""
        End If
        cboCustomer.SetFocus
    End If
End Sub

Private Sub cboCustomer_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cboCigarette.SetFocus
    End If
    
End Sub

Private Sub cboGroupBh_Click()
    If Trim(cboGroupBh.Text) = "" Then
        MsgBox "请务必选择队别！", vbExclamation, "系统提示"
        Exit Sub
    End If
    conn.Query_RsStatic rs, "select customerid,name from customers where groupbh=" & Left(Trim(cboGroupBh.Text), 1)
    cboCustomer.Clear
    While Not rs.EOF
        cboCustomer.AddItem rs.Fields(0) & "  " & rs.Fields(1)
        rs.MoveNext
    Wend
End Sub

Private Sub CDTFGridUser_SelectClick()
    CDTFGridUser.GetselectItem vtemp, 3
   cmdUserOk.Caption = "保存(&S)"
   Label19.Caption = vtemp(0)
   Text1.Text = vtemp(1)
   Text2.Text = vtemp(2)
End Sub

Private Sub CDTFGridXy_SelectClick()
    CDTFGridXy.GetselectItem vhead, 5
    cmdCigaOK.Caption = "保存(&S)"
    Text3.Enabled = False
    Text3.Text = vhead(0)
    Text4.Text = vhead(1)
    Text5.Text = vhead(2)
    Text6.Text = vhead(3)
    Text7.Text = vhead(4)
    
    
End Sub

Private Sub cdtfMainGrid_SelectClick()
    cdtfMainGrid.GetselectItem vtemp, 3
    txtOrderNum.Text = vtemp(2)
    Command3.Enabled = True
    cmdSave.Enabled = True
    
End Sub

Private Sub Check1_Click()
     
     If Check1.value = 1 Then
        If Trim(cboCustomer.Text) = "" Then
            MsgBox "请选择一个零售户！", vbExclamation, "系统提示"
            Check1.value = 0
            Exit Sub
    End If
        'str = "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.customerid))=" & Trim(Left(cboCustomer.Text, 3)) & " and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        conn.Query_RsStatic rs, "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.customerid))=" & Trim(Left(cboCustomer.Text, 3)) & " and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2) & " order by saledate"
        cdtfMainGrid.ClearData
        cdtfMainGrid.IniListviewData rs, 3
        conn.Query_RsStatic rs, "select sum(b.ordernum) as sumOrder ,sum(b.ordernum*c.xyjg) as totalMoney from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.customerid))=" & Trim(Left(cboCustomer.Text, 3)) & " and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        If rs.Fields(0) <> 0 Then
            Label11.Caption = rs.Fields(0)
            Label13.Caption = rs.Fields(1)
        Else
            Label11.Caption = ""
            Label13.Caption = ""
        End If

        cboCustomer.SetFocus
    Else
        'str = "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        conn.Query_RsStatic rs, "select a.name,c.xymc,b.OrderNum from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2) & " order by saledate"
        cdtfMainGrid.ClearData
        cdtfMainGrid.IniListviewData rs, 3
        conn.Query_RsStatic rs, "select sum(b.ordernum) as sumOrder ,sum(b.ordernum*c.xyjg) as totalMoney from customers a,saledetail b,cigarette c where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(b.xybh))=ltrim(rtrim(c.xybh)) and convert(char(10),saledate,21)=convert(char(10),getdate(),21)  and a.groupbh=" & Left(Trim(cboGroupBh.Text), 2)
        If rs.Fields(0) <> 0 Then
            Label11.Caption = rs.Fields(0)
            Label13.Caption = rs.Fields(1)
        Else
            Label11.Caption = ""
            Label13.Caption = ""
        End If

        cboCustomer.SetFocus
    End If
        
End Sub

Private Sub cmdAdd_Click()
Dim intGroupid As Integer
Dim rstmp As New Recordset
Dim rstmp1 As New Recordset
Dim Sqlstr As String
If Trim(cboCustomer.Text) = "" Then
    MsgBox "请选择一个零售户！", vbExclamation, "系统提示"
    cboCustomer.SetFocus
    Exit Sub
End If
If Trim(cboCigarette.Text) = "" Then
    MsgBox "请选择所销售的香烟品名！", vbExclamation, "系统提示"
    cboCigarette.SetFocus
    Exit Sub
End If
If Trim(txtSaleNum.Text) = "" Then
    MsgBox "请录入销售数量！", vbExclamation, "系统提示"
    Exit Sub
End If
conn.Query_RsStatic rs, "select xyjg from cigarette where xybh=" & Left(cboCigarette.Text, 3)
If rs.Fields(0) = 0 Then
    MsgBox "该香烟当前价格为零！请确认。", vbExclamation, "系统提示"
    Exit Sub
End If
'If Trim(txtValidate.Text) = "" Then
'    MsgBox "请录入校验值！", vbExclamation, "系统提示"
'    Exit Sub
'End If
'If Trim(txtSaleNum.Text) <> Trim(txtValidate.Text) Then
'    MsgBox "您所输入的销售数量不一致！", vbExclamation, "系统提示"
'    txtSaleNum.SetFocus
'    Exit Sub
'End If
conn.Query_RsStatic rs, "select distinct customerid from saledetail where convert(char(10),saledate,21)=convert(char(10),getdate(),21)"
conn.Query_RsStatic rstmp, "select distinct customerid from saledetail where convert(char(10),saledate,21)=convert(char(10),getdate(),21) and customerid=" & Trim(Left(cboCustomer.Text, 3))
If (rs.RecordCount Mod 12) = 0 And rstmp.RecordCount = 0 Then
    intGroupid = Int(((rs.RecordCount) / 12)) + 1
Else
    intGroupid = Int((rs.RecordCount + 11) / 12)
End If
conn.Query_RsStatic rstmp1, "select * from saledetail where xybh=" & Trim(Left(cboCigarette.Text, 4)) & " and customerid=" & Trim(Left(cboCustomer.Text, 3)) & " and convert(char(10),saledate,21)= convert(Char(10), getdate(), 21)"
If rstmp1.RecordCount > 0 Then
    Sqlstr = "update saledetail set ordernum=ordernum+" & Trim(txtSaleNum.Text) & " from saledetail where xybh=" & Trim(Left(cboCigarette.Text, 4)) & " and customerid=" & Trim(Left(cboCustomer.Text, 3)) & " and convert(char(10),saledate,21)=convert(Char(10), getdate(), 21)"
    conn.Update_SqlState Sqlstr
    If Check1.value = 1 Then
        If Trim(cboCustomer.Text) = "" Then
            MsgBox "请选择一个零售户！", vbExclamation, "系统提示"
            Check1.value = 0
            Exit Sub
        End If