想鸟一样飞翔

专注于php开发。对c++也很有兴趣!!!

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
创建Excel,把数据存入Excel  
  Private   Sub   ComExport_Click()  
          Dim   xlApp   As   New   Excel.Application  
          Dim   xlBook   As   New   Excel.Workbook       '定義Excel工作簿對象  
          Dim   xlSheet   As   New   Excel.Worksheet   '定義Excel工作表對象  
           
          Dim   line   As   Integer,   M   As   Integer,   n   As   Integer  
           
          Dim   savepath   As   String     '定義保存路徑  
           
          CommonDialog1.CancelError   =   True       '設置cancelError為ture  
           
          On   Error   GoTo   errhandler  
          CommonDialog1.Flags   =   cdlOFNHideReadOnly  
           
           
          CommonDialog1.FileName   =   "Report"  
           
          CommonDialog1.DefaultExt   =   ".xls"  
           
          CommonDialog1.Filter   =   "Excel(*.xls)|*.xls|Text(*.txt)|*.txt"  
           
          CommonDialog1.FilterIndex   =   1  
           
          CommonDialog1.Flags   =   &H2  
           
          CommonDialog1.ShowSave  
           
          If   ERR.Number   =   cdlCancel   Then  
           
                  Exit   Sub  
           
          End   If  
           
          savepath   =   CommonDialog1.FileName  
           
          ''######################以下是匯入到excel  
           
            Set   xlApp   =   CreateObject("Excel.Application")  
          '   xlApp.Visible   =   True                   '根据操作人是否需見到Excel此處可設TRUE   或FALSE  
          xlApp.Visible   =   False  
           
          Set   xlBook   =   xlApp.Workbooks.add  
          On   Error   Resume   Next  
          Set   xlSheet   =   xlBook.Worksheets(1)  
          If   k   =   2   Then     'by   機台編號  
                  str_eqid   =   ""  
                  n   =   0  
                  M   =   1                                                               '得到的str_eqid   用與excel  
                  For   M   =   0   To   ListSbbh.ListCount   -   1  
                          If   ListSbbh.Selected(M)   =   True   Then  
                                  str_eqid   =   str_eqid   &   Trim(ListSbbh.List(M))  
                                  If   n   <   ListSbbh.SelCount   Then  
                                          str_eqid   =   str_eqid  
                                  End   If  
                                  n   =   n   +   1  
                          End   If  
                  Next   M  
                    xlSheet.Cells(1,   4)   =   "EQ   Down   Top10   Report"  
                  xlSheet.Cells(2,   1)   =   "Date:"  
                  xlSheet.Cells(2,   2)   =   Format(DTPickerStart.Value,   "yyyy-mm-dd")   &   "     07:30:00"  
                  xlSheet.Cells(2,   3)   =   "TO"  
                  xlSheet.Cells(2,   4)   =   Format(DTPickerEnd.Value   +   1,   "yyyy-mm-dd")   &   "     07:30:00"  
                  xlSheet.Cells(3,   1)   =   "Eqid:"  
                  xlSheet.Cells(3,   2)   =   str_eqid  
                   
                  xlSheet.Cells(4,   1)   =   "Bug   Poenomenon"  
                  xlSheet.Cells(5,   1)   =   "Quantity"  
                   
                  rsgzxx.MoveFirst  
                   
                  line   =   4  
                  Do   While   Not   rsgzxx.EOF  
                          xlSheet.Cells(4,   line).Value   =   rsgzxx("poenomenon").Value  
                          xlSheet.Cells(5,   line).Value   =   rsgzxx("quantity").Value  
                           
                          line   =   line   +   1  
                          rsgzxx.MoveNext  
                  Loop  
          End   If  
   
            xlBook.SaveAs   FileName:=savepath,   FileFormat:=xlNormal,   _  
          PassWord:="",   WriteResPassword:="",   ReadOnlyRecommended:=False,   _  
          CreateBackup:=False  
          xlBook.Saved   =   True       '保存到Excel  
          MsgBox   "保存成功!",   vbOKOnly,   "信息"  
          '結束EXcel進程  
          xlApp.Quit     '  
          Set   xlSheet   =   Nothing  
          Set   xlBook   =   Nothing  
          Set   xlApp   =   Nothing  
           
  errhandler:  
           
          Exit   Sub  
           
  End   Sub  
posted on 2007-08-09 22:10  redfox  阅读(1549)  评论(0编辑  收藏  举报