QTP调用Excel的一些函数（转）--供参考

Dim ExcelApp   'As Excel.Application

Dim excelSheet 'As Excel.worksheet

Dim excelBook  'As Excel.workbook

Dim fso        'As scrīpting.FileSystemObject

' *********************************************************************************************

'函数说明：创建一个Excel应用程序ExcelApp,并创建一个新的工作薄Workbook;

'参数说明：无

'调用方法:

'          CreateExcel()

' *********************************************************************************************

Function CreateExcel()

   Dim excelSheet

   Set ExcelApp = CreateObject("Excel.Application")

   ExcelApp.Workbooks.Add

   ExcelApp.Visible = True

   Set CreateExcel = ExcelApp

End Function

' *********************************************************************************************

'函数说明：关闭Excel应用程序;

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'调用方法:

'          CloseExcel(ExcelApp)

' *********************************************************************************************

Sub CloseExcel(ExcelApp)

   Set excelSheet = ExcelApp.ActiveSheet

   Set excelBook = ExcelApp.ActiveWorkbook

   Set fso = CreateObject("scrīpting.FileSystemObject")

   On Error Resume Next

   fso.CreateFolder "C:\Temp"

   fso.DeleteFile "C:\Temp\ExcelExamples.xls"

   excelBook.SaveAs "C:\Temp\ExcelExamples.xls"

   ExcelApp.Quit

   Set ExcelApp = Nothing

   Set fso = Nothing

   Err = 0

   On Error GoTo 0

End Sub

' *********************************************************************************************

'函数说明：保存工作薄;

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'         (2)workbookIdentifier:属于ExcelApp的工作薄名称;

'         (3)path:保存的路径;

'返回结果：

'         (1)保存成功，返回字符串：OK

'         (2)保存失败，返回字符串：Bad Worksheet Identifier

'调用方法:

'          ret = SaveWorkbook(ExcelApp, "Book1", "D:\Example1.xls")

' *********************************************************************************************

Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String

   Dim workbook

   On Error Resume Next '启用错误处理程序

   Set workbook = ExcelApp.Workbooks(workbookIdentifier)

   On Error GoTo 0  '禁用错误处理程序

   If Not workbook Is Nothing Then

       If path = "" Or path = workbook.FullName Or path = workbook.Name Then

           workbook.Save

       Else

           Set fso = CreateObject("scrīpting.FileSystemObject")

           '判断路径中是否已添加扩展名.xls

           If InStr(path, ".") = 0 Then

               path = path & ".xls"

           End If

           '删除路径下现有同名的文件

           On Error Resume Next

           fso.DeleteFile path

           Set fso = Nothing

           Err = 0

           On Error GoTo 0

           workbook.SaveAs path

       End If

       SaveWorkbook = "OK"

   Else

       SaveWorkbook = "Bad Workbook Identifier"

   End If

End Function

' *********************************************************************************************

'函数说明：设置工作表excelSheet单元格的值

'参数说明：

'         (1)excelSheet:工作表名称;

'         (2)row:列的序号,第一列为1;

'         (3)column:行的序号,第一行为1;

'         (4)value:单元格要设置的值;

'返回结果：

'         无返回值

'调用方法:

'          SetCellValue excelSheet1, 1, 2, "test\"

' *********************************************************************************************

Sub SetCellValue(excelSheet, row, column, value)

   On Error Resume Next

   excelSheet.Cells(row, column) = value

   On Error GoTo 0

End Sub

'The GetCellValue returns the cell's value according to its row column and sheet

'excelSheet - the Excel Sheet in which the cell exists

'row - the cell's row

'column - the cell's column

'return 0 if the cell could not be found

' *********************************************************************************************

'函数说明：获取工作表excelSheet单元格的值

'参数说明：

'         (1)excelSheet:工作表名称;

'         (2)row:列的序号;

'         (3)column:行的序号;

'返回结果：

'         (1)单元格存在,返回单元格值;

'         (2)单元格不存在，返回0;

'调用方法:

'          set CellValue = GetCellValue(excelSheet, 1, 2)

' *********************************************************************************************

Function GetCellValue(excelSheet, row, column)

   value = 0

   Err = 0

   On Error Resume Next

   tempValue = excelSheet.Cells(row, column)

   If Err = 0 Then

       value = tempValue

       Err = 0

   End If

   On Error GoTo 0

   GetCellValue = value

End Function

' *********************************************************************************************

'函数说明：获取并返回工作表对象

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'         (2)sheetIdentifier:属于ExcelApp的工作表名称;

'返回结果：

'         (1)成功：工作表对象Excel.worksheet

'         (1)失败：Nothing

'调用方法:

'          Set excelSheet1 = GetSheet(ExcelApp, "Sheet Name")

' *********************************************************************************************

Function GetSheet(ExcelApp, sheetIdentifier)

   On Error Resume Next

   Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)

   On Error GoTo 0

End Function

' *********************************************************************************************

'函数说明：添加一张新的工作表

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'         (2)workbookIdentifier:属于ExcelApp的工作薄名称;

'         (2)sheetName:要插入的工作表名称;

'返回结果：

'         (1)成功：工作表对象worksheet

'         (1)失败：Nothing

'调用方法:

'          InsertNewWorksheet(ExcelApp, workbookIdentifier, "new sheet")

' *********************************************************************************************

Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName)

   Dim workbook 'As Excel.workbook

   Dim worksheet 'As Excel.worksheet

   '如果指定的工作薄不存在，将在当前激活状态的工作表中添加工作表

   If workbookIdentifier = "" Then

       Set workbook = ExcelApp.ActiveWorkbook

   Else

       On Error Resume Next

       Err = 0

       Set workbook = ExcelApp.Workbooks(workbookIdentifier)

       If Err <> 0 Then

           Set InsertNewWorksheet = Nothing

           Err = 0

           Exit Function

       End If

       On Error GoTo 0

   End If

   sheetCount = workbook.Sheets.Count '获取工作薄中工作表的数量

   workbook.Sheets.Add , sheetCount '添加工作表

   Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet为新添加的工作表对象

   '设置新添加的工作表名称

   If sheetName <> "" Then

       worksheet.Name = sheetName

   End If

   Set InsertNewWorksheet = worksheet

End Function

' *********************************************************************************************

'函数说明：修改工作表的名称;

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'         (2)workbookIdentifier:属于ExcelApp的工作薄名称;

'         (3)worksheetIdentifier:属于workbookIdentifier工作薄的工作表名称;

'         (4)sheetName:修改后的工作表名称;

'返回结果：

'         (1)修改成功，返回字符串：OK

'         (2)修改失败，返回字符串：Bad Worksheet Identifier

'调用方法:

'          set ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "Sheet Name")

' *********************************************************************************************

Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName)

   Dim workbook

   Dim worksheet

   On Error Resume Next

   Err = 0

   Set workbook = ExcelApp.Workbooks(workbookIdentifier)

   If Err <> 0 Then

       RenameWorksheet = "Bad Workbook Identifier"

       Err = 0

       Exit Function

   End If

   Set worksheet = workbook.Sheets(worksheetIdentifier)

   If Err <> 0 Then

       RenameWorksheet = "Bad Worksheet Identifier"

       Err = 0

       Exit Function

   End If

   worksheet.Name = sheetName

   RenameWorksheet = "OK"

End Function

' *********************************************************************************************

'函数说明：删除工作表;

'参数说明：

'         (1)ExcelApp:Excel应用程序名称;

'         (2)workbookIdentifier:属于ExcelApp的工作薄名称;

'         (3)worksheetIdentifier:属于workbookIdentifier工作薄的工作表名称;