vba报表制作

Option Explicit
Dim sql, tj As String, rnum As Double, r As Integer
 
Private Sub CommandButton1_Click()
'刷新库存
On Error Resume Next
 
    Dim rowcount As Double
    rowcount = ActiveSheet.UsedRange.Rows.Count
    If rowcount > 4 Then
      ActiveSheet.Range("5:" + CStr(rowcount)).EntireRow.Delete
    End If
    Select Case Sheet1.Range("G1")
      Case "全部"
            tj = ""
      Case "大于0"
            tj = "and T0.[CQTY]>0"
      Case "等于0"
            tj = "and T0.[CQTY]=0"
      Case "小于0"
            tj = "and T0.[CQTY]<0"
    End Select
     
Call OpenCn
  Application.StatusBar = "正在访问数据库,请稍等...."
  sql = "select t2.name,t1.name_template,t3.material,t3.cust_spec,sum(qty) from stock_quant t0 left join product_product t1 on t1.id=t0.product_id left join product_template t3 on t3.id=t1.product_tmpl_id" _
        & " left join stock_location t2 on t2.id=t0.location_id where t2.name='" + Trim(Sheet1.Range("E1")) + "' group by t1.name_template,t3.material,t3.cust_spec,t2.name;"
        Sheet3.Range("A1") = sql
  rs.CursorLocation = adUseClient
  rs.Open sql, cn, 1, 1
  rnum = rs.RecordCount
  If rnum < 1 Then
    MsgBox "没有记录,请您确认条件后查询! 谢谢!"
  Else
    Sheet1.Range("A5").CopyFromRecordset rs
    Call Style(rnum)
  End If
Call CloseCn
r = 5
'MsgBox Sheet1.Cells(r, 7)
While Len(Sheet1.Cells(r, 7)) > 3
  If Len(Sheet1.Cells(r, 7)) = 6 Then
    Sheet1.Cells(r, 7).Interior.ColorIndex = 3
  ElseIf (Len(Sheet1.Cells(r, 7)) = 10) Then
    Sheet1.Cells(r, 7).Interior.ColorIndex = 6
  End If
   
  r = r + 1
Wend
Application.StatusBar = "查询完成,共计:" + CStr(rnum) + "条记录"
End Sub