（有代码）报表和创建commandbutton控件的问题，

Question

set "comm&"p=me.controls.add("vb.commandbutton","name"&p)
'"comm&"p 是一个字符串常量，而不是comm1(comm2..)
应该：
 set comm1=me.constros.add("vb.commandbutton","name1")
 set comm2=me.constros.add("vb.commandbutton","name2")
...
...   with "thecomm"&p           '说明1
同上，只能是：
with comm1
'with comm2
'...

Answer 1

楼上的兄弟，你这样不是不能通过循环语句实现了吗，"comm&"p 是一个字符串常量，不错，可是如果要创建三十个这样的对象，难道要书写三十对with……end with吗？这可苦了我啦，我要循环语句实现啦！ 这就是我的重点呀？

Answer 2

请问各类大侠，象这种问题是不是需要定义类才能解决呀，但是问题是在类中也不能对commandbutton对象的name赋值呀，大侠救我啊，分不是问题！！一经解决，立马散分呀！

Answer 3

您可以这样解决
Private Sub Command1_Click()
    Dim cmd As CommandButton
    
    Set cmd = Me.Controls.Add("VB.CommandButton", "cmd1")
    With cmd
        .Width = 1000
        .Height = 1000
        .Top = 1000
        .Left = 1000
        .Visible = True
        .ZOrder
        .Caption = "cmd1"
    End With
    MsgBox cmd.Name
End Sub
Private Sub Command2_Click()
'''''''''''''''''''''''''''''''''''''''''
' 用Controls对象
'''''''''''''''''''''''''''''''''''''''''
    With Me.Controls("cmd" & CStr(1))
        .Caption = "cmd2"
    End With
End Sub

Answer 4

但是，添加控件时候好像就不行了:(
您需要自己写30个controls.add

Answer 5

赫赫，原来还有更简单的方法Public WithEvents cmd1 As CommandButton
Public WithEvents cmd2 As CommandButton
Public WithEvents cmd3 As CommandButton
Public WithEvents cmd4 As CommandButton
Public WithEvents cmd5 As CommandButton'注意，一定要public，否则不能用callbyname获得Private Sub cmd1_Click()
    MsgBox "ok"
End SubPrivate Sub Command1_Click()
    Dim i As Integer
    
    For i = 1 To 5
        CallByName Me, "cmd" & CStr(i), VbSet, Controls.Add("VB.CommandButton", "cmd" & CStr(i))
        With CallByName(Me, "cmd" & CStr(i), VbGet)
            .Caption = "cmd" & CStr(i)
            .Width = 1000
            .Height = 500
            .Left = 1000
            .Top = 550 * i
            .Visible = True
        End With
    Next
End Sub

Answer 6

用控件数组行不行啊？
先在窗体上放一个command控件，index 设为0
for i=1 to 30
load command(i)
command(i).caption="caption"&trim(str(i))
....
command(i).visible=true
next写command的事件时再用  index 判断
select case index
case 1
....
end select

Answer 7

风之兄的办法我没试过，你这样可以给每个commandbutton对象定义name吗，如果我又想给每个对象响应事件应如何处理啊？我最好将代码放在form load内。很谢谢大家的关注。

Answer 8

您可以在datareport中加一个subsub filterrecord()
  dataenv1.rscmd1.filter="fld1<>0"
end sub

Answer 9

这个SUB加在哪个代码段呢，每次都执行吗，你们做报表是用什么做的，水晶报表做的怎么样呀

Answer 10

show以前执行
放在datareport中

Answer 11

at data report
===========================================
Public StartTime As String
Public EndTime As StringPublic Sub ShowData()
    Dim cmd As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim BillsRs As New ADODB.Recordset
    
    DataEnv.rsTEA.Close
       
    cmd.ActiveConnection = SYScnn
    cmd.CommandType = adCmdText
    cmd.CommandText = "UPDATE TEA SET STATCOUNT=0"
    cmd.Execute
    cmd.CommandText = "UPDATE TEA SET STATCOST=0"
    cmd.Execute
    
    cmd.CommandText = "SELECT SUM(PRIVATECOST) AS PCOST, SUM(ADDCOST) AS ACOST, SUM(FACTCOST) AS TOTALCOST , SUM(SERVICECOST) AS SCOST" & _
        " FROM BILL " & _
        " WHERE ETIME>='" & StartTime & "' AND ETIME<='" & EndTime & "'"
    rs.Open cmd.Execute
    Me.Sections("Title").Controls("TimeLbl").Caption = StartTime & " 至 " & EndTime
    Me.Sections("Last").Controls("PrivateLbl").Caption = CStr(Format(CCur(rs.Fields("PCOST")), "￥#,##0.00"))
    Me.Sections("Last").Controls("AddLbl").Caption = CStr(Format(CCur(rs.Fields("ACOST")), "￥#,##0.00"))
    Me.Sections("Last").Controls("ServiceLbl").Caption = CStr(Format(CCur(rs.Fields("SCOST")), "￥#,##0.00"))
    Me.Sections("Last").Controls("TotalLbl").Caption = CStr(Format(CCur(rs.Fields("TOTALCOST")), "总收入：￥#,##0.00"))
    rs.Close
    Set rs = Nothing
    cmd.CommandText = "SELECT * FROM BILL " & _
        " WHERE ETIME>='" & StartTime & "' AND ETIME<='" & EndTime & "'"
    rs.Open cmd.Execute
    
    BillsRs.Open "BILLS", SYScnn
    Do Until rs.EOF
        BillsRs.Filter = "BILLID=" & rs.Fields("ID")
        If Not BillsRs.EOF Then BillsRs.MoveFirst
        Do Until BillsRs.EOF
            cmd.CommandText = "UPDATE TEA SET STATCOUNT=STATCOUNT+" & BillsRs.Fields("AMOUNT") & _
                " WHERE ID=" & BillsRs.Fields("TEAID")
            cmd.Execute
            cmd.CommandText = "UPDATE TEA SET STATCOST=STATCOST+" & BillsRs.Fields("TOTAL") & _
                " WHERE ID=" & BillsRs.Fields("TEAID")
            cmd.Execute
            BillsRs.MoveNext
        Loop
        rs.MoveNext
    Loop
    BillsRs.Close
    rs.Close
    DataEnv.TEA
    DataEnv.rsTEA.Filter = "STATCOUNT > 0"
End SubPrivate Sub DataReport_Initialize()
    DataEnv.TEA
End SubPrivate Sub DataReport_Terminate()
    DataEnv.rsTEA.Close
End Subat form
====================================    rpt.StartTime = Stime
    rpt.EndTime = Etime
    rpt.ShowData
    rpt.Show vbModal, MainForm这是我很久以前的代码了:)

Answer 12

您可以翻查以前的文章还可以导出到EXCEL报表中

Answer 13

Private Type ExlCell
    Row As Long
    Col As Long
End TypeDim ExcelSheet As Excel.Application
Dim ValuesArray() As StringPublic Function MakeExcelFile(MasterRs As ADODB.Recordset, FieldsArray() As String, _
            ReportCaption As String, MasterForm As frmCreateReport)
    
    Dim WS As Worksheet
    Dim StCell As ExlCell
    
    Screen.MousePointer = vbHourglass    Set ExcelSheet = CreateObject("Excel.Application")
    ExcelSheet.Workbooks.Add
    ExcelSheet.Worksheets(1).Name = ReportCaption
    Set WS = ExcelSheet.Worksheets(1)
    
    StCell.Col = 1
    StCell.Row = 3
    Call CopyRecords(MasterRs, WS, StCell, FieldsArray, MasterForm)
    Screen.MousePointer = vbDefault
    
    ExcelSheet.Visible = True
    ExcelSheet.Interactive = True
    Set ExcelSheet = Nothing
End Function
Private Sub CopyRecords(RST As ADODB.Recordset, WS As Worksheet, StartingCell As ExlCell, _
                    FieldsArray() As String, MasterForm As frmCreateReport)
    
    Dim SomeArray() As Variant
    Dim Row         As Long
    Dim Col         As Long
    Dim Recs As Integer
    Dim Counter As Integer
    Dim i As Integer
    
    If RST.EOF And RST.BOF Then Exit Sub
    RST.MoveLast
    ReDim SomeArray(RST.RecordCount + 1, UBound(FieldsArray))
    Col = 0
    For Col = 0 To UBound(FieldsArray)
        SomeArray(0, Col) = FieldsArray(Col)
    Next
    RST.MoveFirst
    Recs = RST.RecordCount
    Counter = 0
    For Row = 1 To RST.RecordCount
        Counter = Counter + 1
        If Counter <= Recs Then i = (Counter / Recs) * 100
        MasterForm.UpdateProgress i
        For Col = 0 To UBound(FieldsArray)
            SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
            If IsNull(SomeArray(Row, Col)) Then _
            SomeArray(Row, Col) = ""
        Next
        RST.MoveNext
    Next    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).Value = SomeArray
    
    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlRight
    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).Borders.LineStyle = xlContinuous
        
        
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Merge
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Size = 20
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Bold = True
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Value = WS.Name
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlCenter
    WS.Columns.AutoFit
    MasterForm.UpdateProgress 100
End SubFieldsArray就是您想要显示的字段，可以在之前处理
我是这样使用的
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    
    If txtCaption = "" Then
        MsgBox "必须输入报表标题！", vbExclamation, "错误"
        txtCaption.SetFocus
        Exit Sub
    End If
    If ListReportFields.ListCount = 0 Then
        MsgBox "必须选择显示字段！", vbExclamation, "错误"
        Exit Sub
    End If
    
    ReDim FieldsArray(ListReportFields.ListCount - 1)
    
    For i = 0 To ListReportFields.ListCount - 1
        FieldsArray(i) = ListReportFields.List(i)
    Next
    
    rs.Open "场地租用", SYScnn
    rs.Filter = Condition
    MakeExcelFile rs, FieldsArray(), txtCaption, Me
    rs.Close
    Unload Me