mainfrm.frm

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

        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) 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) "
        Label11.Caption = rs.Fields(0)
        Label13.Caption = rs.Fields(1)
        cboCigarette.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) 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)"
        If rs.Fields(0) <> 0 Then
            Label11.Caption = rs.Fields(0)
            Label13.Caption = rs.Fields(1)
        Else
            Label11.Caption = ""
            Label13.Caption = ""
        End If
        cboCigarette.SetFocus
    End If
    Exit Sub
End If
 conn.Query_RsStatic rs, "select top 1 customerid,groupid from saledetail where customerid=" & Trim(Left(cboCustomer.Text, 3))

If rs.RecordCount > 0 Then
    intGroupid = rs.Fields(1)
End If
If conn.Update_SqlState("insert into SaleDetail (customerid,xybh,ordernum,groupid) values(" & Trim(Left(cboCustomer.Text, 3)) & "," & Trim(Left(cboCigarette.Text, 4)) & "," & Trim(txtSaleNum.Text) & "," & intGroupid & ")") Then
    MsgBox "成功添加新销售记录！", , "系统提示"
    cboGroup.Clear
    conn.Query_RsStatic rs, "select distinct groupid from saledetail where convert(char(10),saledate,21)=convert(char(10),getdate(),21)"
    While Not rs.EOF
        cboGroup.AddItem rs.Fields(0)
        rs.MoveNext
    Wend
    Beep
    If Check1.value = 1 Then
        If Trim(cboCustomer.Text) = "" Then
            MsgBox "请选择一个零售户！", vbExclamation, "系统提示"
            Check1.value = 0
            Exit Sub
        End If
        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
        cboCigarette.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
        cboCigarette.SetFocus
    End If
Else
    Beep
    Beep
    Beep
    Exit Sub
End If

End Sub

Private Sub cmdAddCiga_Click()
    conn.Query_RsStatic rs, "select * from cigarette"
    CDTFGridXy.SetColumnWidth 2, 1200
    CDTFGridXy.IniListviewData rs, 5
    Text3.Enabled = True
    Frame5.Visible = True
End Sub

Private Sub cmdAddUser_Click()
    conn.Query_RsStatic rs, "select max(convert(int,customerid)) from customers"
    Label19.Caption = rs.Fields(0) + 1
    cmdUserOk.Caption = "添加(&A)"
    conn.Query_RsStatic rs, "select * from customers"
    CDTFGridUser.IniListviewData rs, 3
    Frame4.Visible = True
End Sub

Private Sub cmdCigaOK_Click()
    Dim value As String
    If cmdCigaOK.Caption = "添加(&A)" Then
        value = "('" & Trim(Text3.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Text5.Text) & "'," & Trim(Text6.Text) & "," & Trim(Text7.Text) & ")"
        If conn.Update_SqlState("insert into cigarette values" & value) Then
            MsgBox "成功添加新品", vbOKOnly, "系统提示"
        Else
            MsgBox "添加新品出错", vbExclamation, "系统提示"
        End If
    Else
        If conn.Update_SqlState("update cigarette set xybh='" & Trim(Text3.Text) & "',xymc='" & Trim(Text4.Text) & "',sccj='" & Trim(Text5.Text) & "',xyjg=" & Trim(Text6.Text) & ",orderid=" & Trim(Text7.Text) & " where xybh=" & Trim(Text3.Text)) Then
            MsgBox "成功更改香烟信息", vbOKOnly, "系统提示"
        Else
            MsgBox "更改香烟信息出错", vbExclamation, "系统提示"
        End If
    End If
End Sub

Private Sub cmdExit_Click()
    Set rs = Nothing
    Set conn = Nothing
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim str As String
    str = "update saledetail set ordernum=" & Trim(txtOrderNum.Text) & " from saledetail a,cigarette b,customers c where a.ordernum=" & vtemp(2) & " and b.xymc='" & vtemp(1) & "' and a.xybh=b.xybh and a.customerid=c.customerid and c.name='" & vtemp(0) & "' and convert(char(10),saledate,21)=convert(char(10),getdate(),21)"
    If conn.Update_SqlState(str) Then
        MsgBox "成功修改所选销售信息！", , "系统提示"
    Else
        MsgBox "连接数据库出错！", vbExclamation, "系统提示"
        cmdSave.Enabled = False
        Command3.Enabled = False
        Exit Sub
    End If
    If Check1.value = 1 And Trim(cboCustomer.Text) <> "" 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) order by a.name"
        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)"
        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) order by a.name"
        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)"
        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
    cmdSave.Enabled = False
    Command3.Enabled = False
End Sub

Private Sub cmdUserCancel_Click()
    Text1.Text = ""
    Text2.Text = ""
    Frame4.Visible = False
End Sub

Private Sub cmdUserOk_Click()
    Dim value As String
    If cmdUserOk.Caption = "添加(&A)" Then
        value = "('" & Trim(Label19.Caption) & "','" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "')"
        If conn.Update_SqlState("insert into customers values" & value) Then
            MsgBox "成功添加新用户", vbOKOnly, "系统提示"
        Else
            MsgBox "添加新用户出错", vbExclamation, "系统提示"
        End If
    Else
        If conn.Update_SqlState("update customers set name='" & Trim(Text1.Text) & "',groupbh='" & Text2.Text & "' where customerid=" & Trim(Label19.Caption)) Then
            MsgBox "成功更改用户信息", vbOKOnly, "系统提示"
        Else
            MsgBox "更改用户信息出错", vbExclamation, "系统提示"
        End If
    End If
    
End Sub

Private Sub Command1_Click()
    Dim rstmp As New Recordset
    Dim totalNum As String
    If Trim(cboGroup.Text) = "" Then
        MsgBox "请选择组编号！", vbExclamation, "系统提示"
        Exit Sub
    End If
    Me.MousePointer = 13
    conn.Query_RsStatic rs, "select Table_name from information_schema.tables where table_name='mytemp'"
    If rs.RecordCount > 0 Then
        conn.Update_SqlState "drop table mytemp"
    End If
    Dim Sqlstr As String
    Sqlstr = "select distinct b.name,a.customerid  from saledetail a,customers b where ltrim(rtrim(a.customerid))=ltrim(rtrim(b.customerid)) and ltrim(rtrim(a.groupid))=" & Trim(cboGroup.Text) & " and convert(char(10),a.saledate,21)='" & dtpJS.value & "'"
    conn.Query_RsStatic rstmp, Sqlstr
    If rstmp.RecordCount <= 0 Then
        MsgBox "该天还没有录入任何销售数据！", vbExclamation, "系统提示"
        Me.MousePointer = 0
        Exit Sub
    End If
    Sqlstr = "select all convert(int,ltrim(rtrim(a.xybh))) 编号,a.orderid 序号,a.xymc 香烟名称 into mytemp from cigarette a,saledetail b where customerid=" & rstmp.Fields(1) & " and a.xybh*=b.xybh and convert(char(10),b.saledate,21)='" & dtpJS.value & "'"
    conn.Query_RsStatic rs, Sqlstr
    totalNum = " "
    
    Set DataGrid1.DataSource = rs
    While Not rstmp.EOF
        Sqlstr = "select all b.ordernum as " & rstmp.Fields(0) & " from cigarette a,saledetail b where customerid=" & rstmp.Fields(1) & " and a.xybh*=b.xybh and convert(char(10),b.saledate,21)='" & dtpJS.value & "'"
        conn.Query_RsStatic rs, Sqlstr
        conn.Update_SqlState "alter table mytemp add " & rstmp.Fields(0) & "float  null"
        Sqlstr = "update mytemp set " & rstmp.Fields(0) & "=saledetail.ordernum from mytemp,saledetail where mytemp.编号=saledetail.xybh and convert(char(10),saledetail.saledate,21)='" & dtpJS.value & "' and saledetail.customerid in (select customerid from customers where name='" & rstmp.Fields(0) & "')"
        conn.Update_SqlState Sqlstr
        totalNum = totalNum & "isnull(" & Trim(rstmp.Fields(0)) & ",0)+"
        rstmp.MoveNext
    Wend
    conn.Update_SqlState "alter table mytemp add 合计数量 float null default ' ' with values"
    Sqlstr = "update mytemp set 合计数量=convert(char(4),(" & Mid(totalNum, 1, Len(totalNum) - 1) & ")) from mytemp"
    conn.Update_SqlState Sqlstr
    conn.Update_SqlState "update mytemp set 合计数量=' ' from mytemp where ltrim(rtrim(合计数量))='0'"
    conn.Update_SqlState "alter table mytemp add 金额 money null"
    Sqlstr = "update mytemp set 金额=mytemp.合计数量*cigarette.xyjg from mytemp,cigarette where mytemp.编号=cigarette.xybh"
    conn.Update_SqlState Sqlstr
    conn.Query_RsStatic rs, "select * from mytemp where 金额<>0"
    Set DataGrid1.DataSource = rs
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.Count - 3
        If i = 2 Then
            DataGrid1.Columns(i).Width = 1400
        Else
            DataGrid1.Columns(i).Width = 800
        End If
        DataGrid1.Columns(i).Alignment = dbgLeft
    Next i
    DataGrid1.Columns(DataGrid1.Columns.Count - 2).Width = 1200
    DataGrid1.Columns(DataGrid1.Columns.Count - 1).Width = 1000
    Me.MousePointer = 0
End Sub

Private Sub Command2_Click()
    conn.Update_SqlState "update mytemp set 编号=null from mytemp "
    conn.Query_RsStatic rs, "select * from mytemp where 金额<>0 order by 序号"
    Set grpReport.DataSource = rs
    Dim i As Integer
    Dim j As Integer
    i = 2
    While i < rs.Fields.Count - 2
    
    grpReport.Sections("section1").Controls(i - 1).DataField = rs.Fields(i).Name
    grpReport.Sections("section2").Controls(i + 1).Caption = rs.Fields(i).Name
    i = i + 1
    Wend
    j = i
    If i < 14 Then
        
        While i <= 14
            grpReport.Sections("section2").Controls(i + 1).Visible = False
            grpReport.Sections("section1").Controls(i - 1).DataField = rs.Fields(0).Name
            i = i + 1
        Wend
    End If
    While i < 17
        grpReport.Sections("section2").Controls(i + 1).Caption = rs.Fields(j).Name
        grpReport.Sections("section1").Controls(i - 1).DataField = rs.Fields(j).Name
        i = i + 1
        j = j + 1
    Wend
    i = 2
    While i < 14
    If i > rs.Fields.Count - 4 Then
        grpReport.Sections("section5").Controls(i - 1).DataField = rs.Fields(0).Name
    Else
    
        grpReport.Sections("section5").Controls(i - 1).DataField = rs.Fields(i + 1).Name
    End If
    i = i + 1
    Wend
        grpReport.Sections("section5").Controls(13).DataField = rs.Fields(rs.Fields.Count - 2).Name
        grpReport.Sections("section5").Controls(14).DataField = rs.Fields(rs.Fields.Count - 1).Name
    grpReport.Show
End Sub


Private Sub Command3_Click()
     Dim str As String
    str = "delete saledetail from saledetail a,cigarette b,customers c where a.customerid=c.customerid and a.ordernum=" & vtemp(2) & " and b.xymc='" & vtemp(1) & "' and a.xybh=b.xybh and c.name='" & vtemp(0) & "' and convert(char(10),saledate,21)=convert(char(10),getdate(),21)"
    If conn.Update_SqlState(str) Then
        MsgBox "成功删除所选销售信息！", , "系统提示"
    Else
        MsgBox "连接数据库出错！", vbExclamation, "系统提示"
        cmdSave.Enabled = False
        Command3.Enabled = False
        Exit Sub
    End If
    
    If Check1.value = 1 And Trim(cboCustomer.Text) <> "" 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) order by a.name"
        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)"
        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 ltri