创建Excell、保存结果、导出结果

上一篇 / 下一篇  2007-05-22 16:51:54 / 个人分类:EXCELL

'*******************************************************************    
        Dim ExcellApp                                                    '<--As Excel.Application
        Dim excelSheet                                                   '<--As Excel.worksheet
        Dim workbook                                                     '<--As Excel.workbook
        Dim excelbook
        Dim a
        a=now
        a=Cstr(a)
        s = Utilities.StringReplace(a, ":", "-",3)
        s=mid(s,1,len(s)-3)
        Set ExcelApp = CreateObject("Excel.Application")
        Set ExcellApp = CreateExcel(result,myvar)
        ExcellApp.Activeworkbook.saveAs "C:\"+"????测试"+s+".xls"
        ExcellApp.Quit
        Set ExcellApp = nothing
 end sub
'*******************************************************************

 Function CreateExcel(result,myvar)                                      '<--As Excel.Application
          Dim excelSheet                                                 '<--As Excel.worksheet
          Set ExcelApp = CreateObject("Excel.Application")               '<--Create a new excel Object
              ExcelApp.Workbooks.Add                                     '<--创建表头
              ExcelApp.Visible = True
          Set CreateExcel = ExcelApp
          Set NewSheet = ExcelApp.Sheets.Item(1)
              row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(1).Font.Bold = True
              NewSheet.Columns("A:A").ColumnWidth = 40
              NewSheet.Columns("B:B").ColumnWidth = 50
              NewSheet.Columns("B:B").HorizontalAlignment = -4108
              NewSheet.Columns("C:C").ColumnWidth = 10
              NewSheet.Columns("C:C").HorizontalAlignment = -4108
              NewSheet.Columns("D:D").ColumnWidth = 20
              NewSheet.Columns("D:D").HorizontalAlignment = -4108
              NewSheet.Cells(row,1)="测试项目ID序号"
              NewSheet.Cells(row,2)="错误信息"
              NewSheet.Cells(row,3)="测试结果"
              NewSheet.Cells(row,4)="测试时间"
              NewSheet.Cells(row,5)="备    注"
        '''''''''''''''''''''
    for i=2 to 72
          if  result(i-1)="" then                                          '<--写正确信息
              ExcelApp.Application.Visible = True
              ExcelApp.Windows(1).Visible = True
              ' add a new Workbooks and a new Sheet
              'Set NewSheet = ExcelObj.Sheets.Item(1)
              Set NewSheet = ExcelApp.Sheets.Item(1)
             'row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(1).Font.Bold = True 
              NewSheet.rows(i).font.colorindex=5
              'NewSheet.rows(i).font.colorindex=5
              'NewSheet.Cells(i,1)="ID"+cstr(j)
              NewSheet.Cells(i,1)="ID"+cstr(i-1)+myvar(i-1)
          NewSheet.Cells(i,2)="测试已完成"
          NewSheet.Cells(i,3)="Pass"
              NewSheet.Cells(i,4)=Now
              'ExcelObj.Save
             'ExcelObj.close
          else
              ExcelApp.Application.Visible = True                        '<--写错误信息
              ExcelApp.Windows(1).Visible = True
              'add a new Workbooks and a new Sheet
              'Set NewSheet = ExcelObj.Sheets.Item(1)
              Set NewSheet = ExcelApp.Sheets.Item(1)
             'row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(i).Font.Bold = True
              NewSheet.rows(i).font.colorindex=3
              NewSheet.Cells(i,1)="ID"+cstr(i-1)+myvar(i-1)
          NewSheet.Cells(i,2)=result(i-1)
          NewSheet.Cells(i,3)="Fail"
              NewSheet.Cells(i,4)=Now
              'ExcelObj.Save
             'ExcelObj.close
           end if    
    next
End Function


TAG: EXCELL

 

评分:0

我来说两句

日历

« 2024-05-07  
   1234
567891011
12131415161718
19202122232425
262728293031 

数据统计

  • 访问量: 41648
  • 日志数: 55
  • 图片数: 6
  • 书签数: 1
  • 建立时间: 2007-05-22
  • 更新时间: 2007-12-12

RSS订阅

Open Toolbar