modexcel.bas

引用枕善居的天宏钢构仓库管理系统 Ver 2.96

Attribute VB_Name = "ModEXCEL"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/05/11
'描    述：天宏钢构仓库管理系统 Ver 2.96
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
'第一种生成EXCEL方法
Public Sub ExcelDoForVB()

Dim i As Integer, j As Integer
    Dim myexcel As New Excel.Application
    Dim mybook As New Excel.Workbook
    Dim mysheet As New Excel.Worksheet
    Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK
    Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET
     For i = 1 To ado.Recordset.RecordCount
     For j = 1 To ado.Recordset.Fields.count
     mysheet.Cells(i, j) = ado.Recordset.Fields.Item(j - 1).Value
     If (i * j) Mod 500 = 0 Then
     DoEvents
     End If
     Next j
     ado.Recordset.MoveNext
   
     Next i
     myexcel.Visible = True
End Sub
'第二种生成EXCEL方法
Public Sub ExcelDoForVB1()


Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

         strsql1 = "select b.userid as '用户编号' ,b.username as '姓名' ,sum(EvaluationA) + sum(evaluationb)+sum(EvaluationC) as '接待客户数',sum(EvaluationA) as '满意',sum(EvaluationB) AS '一般',SUM(EvaluationC) AS '不满意',(sum(EvaluationA) + sum(evaluationb))*100/(sum(EvaluationA) + sum(evaluationb)+sum(EvaluationC)) AS '满意率'from UserEvaluation a,UserInfo_Win b WHERE convert(char(10),a.servertime,20) > = '2005-06-01'and convert(char(10),a.servertime,20)<  = '2005-09-16' and  a.userid=b.userid group by b.userid,b.username order by b.userid "
       strSQL = "select b.userid as '用户编号' ,b.username as '姓名' ,a.winID as '窗口',a.branch as '楼层',sum(EvaluationA) + sum(evaluationb)+sum(EvaluationC) as '接待客户数',sum(EvaluationA) as '满意',sum(EvaluationB) AS '一般',SUM(EvaluationC) AS '不满意',(sum(EvaluationA) + sum(evaluationb))*100/(sum(EvaluationA) + sum(evaluationb)+sum(EvaluationC)) AS '满意率'from UserEvaluation a,UserInfo_Win b WHERE a.userid=b.userid  and a.branch like  '02%' and a.WINID< = 42 and convert(char(10),a.servertime,20)>   = '2005-06-01'and convert(char(10),a.servertime,20)<   ='2005-09-16' group by b.userid,b.username,a.winID,a.branch order by a.winid"

  rs.Open strSQL, adoCon, adOpenStatic, adLockReadOnly

MsgBox "保存文件到D:\", vbOKOnly + 32, "導入到EXCEL"
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim q As String
Dim EX As Object
Dim exwork As Object
Dim exsheet As Object
Set EX = CreateObject("excel.application")
Set exwork = Nothing
Set exsheet = Nothing
Set exwork = EX.Workbooks().Add
Set exsheet = EX.Worksheets("sheet1")
EX.Range("A1:I1").Merge
EX.Range("A1:I1").Value = "漯河市行政服务中心窗口工作人员评价统计表"
EX.Range("A1:I1").HorizontalAlignment = xlCenter
EX.Range("A1:I1").VerticalAlignment = xlCenter
EX.Range("a2").Value = "用户编号"
   EX.Range("b2").Value = "姓名"
     EX.Range("c2").Value = "窗口"
    EX.Range("d2").Value = "分支"
    
    EX.Range("e2").Value = "接待客户数"
    EX.Range("f2").Value = "满意"
    EX.Range("g2").Value = "一般"
    EX.Range("h2").Value = "不满意"
    
    EX.Range("i2").Value = "满意率"
 


rs.MoveFirst
For i = 2 To rs.RecordCount
    j = 1 + i
    
     For k = 0 To 8
      
       q = Chr(97 + k) & j
        EX.Range(q).Value = rs.Fields(k)
        'que2.Columns(k)
        Next k
          rs.MoveNext
          Next i
           If rs.EOF = False Then
             rs.MoveNext
              End If
 EX.Visible = True
   
 exwork.SaveAs "D:\单位查询.XLS"



    '更新数据库，并显示在网格
 
End Sub