QuickTest Plus帮助文档中EXCEL相关函数

juliet7438 发表于 2006-8-31 23:18:14

QuickTest Plus帮助文档里面的一些EXCEL函数，整理了下
大家参考下
打开QTP，test--settings--resources,将附件文件添加进去就可以使用相关函数了

?
Dim ExcelApp 'As Excel.Application
Dim excelSheet'As Excel.worksheet
Dim excelBook 'As Excel.workbook
Dim fso       'As Scripting.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("Scripting.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")
' *********************************************************************************************

juliet7438 发表于 2006-9-1 00:15:24

' *********************************************************************************************
' 函数说明：保存工作薄;
' 参数说明：
'       (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("Scripting.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

juliet7438 发表于 2006-9-1 00:15:52

' *********************************************************************************************
' 函数说明：添加一张新的工作表
' 参数说明：
'       (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工作薄的工作表名称;
' 返回结果：
'       (1)删除成功，返回字符串：OK
'       (2)删除失败，返回字符串：Bad Worksheet Identifier
' 调用方法:
'       set ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet1")
' *********************************************************************************************

Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier)
Dim workbook 'As Excel.workbook
Dim worksheet 'As Excel.worksheet
On Error Resume Next
Err = 0
Set workbook = ExcelApp.Workbooks(workbookIdentifier)
If Err <> 0 Then
   RemoveWorksheet = "Bad Workbook Identifier"
   Exit Function
End If
Set worksheet = workbook.Sheets(worksheetIdentifier)
If Err <> 0 Then
   RemoveWorksheet = "Bad Worksheet Identifier"
   Exit Function
End If
worksheet.Delete
RemoveWorksheet = "OK"
End Function

' *********************************************************************************************
' 函数说明：添加新的工作薄
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
' 返回结果：
'       (1)成功：工作表对象NewWorkbook
'       (1)失败：Nothing
' 调用方法:
'       set NewWorkbook = CreateNewWorkbook(ExcelApp)
' *********************************************************************************************

Function CreateNewWorkbook(ExcelApp)
Set NewWorkbook = ExcelApp.Workbooks.Add()
Set CreateNewWorkbook = NewWorkbook
End Function

' *********************************************************************************************
' 函数说明：打开工作薄
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
'       (2)path:要打开的工作薄路径;
' 返回结果：
'       (1)成功：工作表对象NewWorkbook
'       (1)失败：Nothing
' 调用方法:
'       set NewWorkbook = CreateNewWorkbook(ExcelApp)
' *********************************************************************************************

Function OpenWorkbook(ExcelApp, path)
On Error Resume Next
Set NewWorkbook = ExcelApp.Workbooks.Open(path)
Set OpenWorkbook = NewWorkbook
On Error GoTo 0
End Function

' *********************************************************************************************
' 函数说明：将工作薄设置为当前工作状态
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
'       (2)workbookIdentifier:要设置为当前工作状态的工作薄名称;
' 返回结果：无返回值;
' 调用方法:
'       ActivateWorkbook(ExcelApp, workbook1)
' *********************************************************************************************

Sub ActivateWorkbook(ExcelApp, workbookIdentifier)
On Error Resume Next
ExcelApp.Workbooks(workbookIdentifier).Activate
On Error GoTo 0
End Sub

' *********************************************************************************************
' 函数说明：关闭Excel工作薄;
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
'       (2)workbookIdentifier:
' 调用方法:
'       CloseWorkbook(ExcelApp, workbookIdentifier)
' *********************************************************************************************

Sub CloseWorkbook(ExcelApp, workbookIdentifier)
On Error Resume Next
ExcelApp.Workbooks(workbookIdentifier).Close
On Error GoTo 0
End Sub

' *********************************************************************************************
' 函数说明：判断两个工作表对应单元格内容是否相等
' 参数说明：
'       (1)sheet1:工作表1的名称;
'       (2)sheet2:工作表2的名称;
'       (3)startColumn:开始比较的行序号;
'       (4)numberOfColumns:要比较的行数;
'       (5)startRow:开始比较的列序号;
'       (6)numberOfRows:要比较的列数;
'       (7)trimed:是否先除去字符串开始的空格和尾部空格后再进行比较,true或flase;
' 返回结果：
'       (1)两工作表对应单元格内容相等：true
'       (2)两工作表对应单元格内容不相等:flase
' 调用方法:
'       ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False)
' *********************************************************************************************

Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed)
Dim returnVal 'As Boolean
returnVal = True

'判断两个工作表是否都存在,任何一个不存在停止判断，返回flase
If sheet1 Is Nothing Or sheet2 Is Nothing Then
   CompareSheets = False
   Exit Function
End If

'循环判断两个工作表单元格的值是否相等
For r = startRow to (startRow + (numberOfRows - 1))
   For c = startColumn to (startColumn + (numberOfColumns - 1))
         Value1 = sheet1.Cells(r, c)
         Value2 = sheet2.Cells(r, c)

         '如果trimed为true,去除单元格内容前面和尾部空格
         If trimed Then
            Value1 = Trim(Value1)
            Value2 = Trim(Value2)
         End If

         '如果单元格内容不一致,函数返回flase
         If Value1 <> Value2 Then
            Dim cell 'As Excel.Range
            '修改sheet2工作表中对应单元格值
            sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'."
            '初始化cell为sheet2中r:c单元格对象
            Set cell = sheet2.Cells(r, c) '
            '将sheet2工作表中对应单元格的颜色设置为红色
            cell.Font.Color = vbRed
            returnVal = False
         End If
   Next
Next
CompareSheets = returnVal
End Function

ztcreative 发表于 2006-9-1 08:43:40

顶你好东西

walker1020 发表于 2006-9-1 10:27:10

楼主真厉害，一下就找到了这么多好东西！总结出这些EXCEL的相关函数，对苦苦寻找 EXCEL相关函数的朋友来说真是雪中送炭呀。谢谢楼主！多谢楼主的无私奉献！

小宝2006 发表于 2006-9-1 11:33:08

顶了先

ljitry 发表于 2006-9-1 17:23:55

不管这么多！我先～～～～～～～～～～

顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？？？？？顶顶
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？？？？？？？？？？？顶顶
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？？？？？？？？？？？？？？顶顶
顶顶顶顶顶顶顶顶顶顶顶？？？？？？？？？？？？？？？？顶顶顶顶顶顶顶顶
顶顶顶顶顶顶顶顶？？？？？？？顶？？？顶顶？？？？？顶顶顶顶顶顶顶顶顶
顶顶顶？？？？？？？？？？？？顶顶顶顶顶顶？？？？顶顶顶顶顶顶顶顶顶顶
顶？？？？？？？？？？？？？？顶顶顶顶顶顶？？？？顶顶顶顶顶顶顶顶顶顶
顶？？？？？？？？？？？？顶顶顶顶顶顶顶？？？？？？？？？？？顶顶顶顶
顶？？？？？？？？？？？？顶顶顶顶顶顶？？？？？？？？？？？？？？顶顶
顶顶？？？？？？？？？？顶顶顶顶顶？？？？？？顶顶顶？？？？？？？顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶顶顶顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶？？顶顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶？？？？顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶？？？？顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶顶？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶？？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶？？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶？？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？？顶？？？？顶顶？？？？？顶顶顶
顶顶顶顶顶顶顶顶？？？？顶顶顶顶？？？顶顶？？？？顶顶？？？？？顶顶顶
顶顶？？顶顶顶？？？？？顶顶顶顶？？？顶顶？？？顶顶顶？？？？？顶顶顶
顶顶？？？？？？？？？？顶顶顶顶顶？？顶顶？？顶顶顶顶？？？？？顶顶顶
顶顶顶？？？？？？？？？顶顶顶顶顶顶顶顶？？？顶顶顶顶顶？？？？顶顶顶
顶顶顶顶顶？？？？？？？顶顶顶顶顶顶顶顶？？？顶？？？？顶顶顶顶顶顶顶
顶顶顶顶顶顶？？？？？？顶顶顶顶顶顶顶？？？？顶顶？？？？？顶顶顶顶顶
顶顶顶顶顶顶顶顶顶？？？顶顶顶顶顶顶？？？？？顶顶顶？？？？？？？顶顶
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？？顶顶顶顶顶？？？？？？顶顶
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？？顶顶顶顶顶顶？？？？？？？顶
顶顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？顶顶顶顶顶顶顶顶顶？？？？？？顶
顶顶顶顶顶顶顶顶顶顶顶顶顶？？？？？顶顶顶顶顶顶顶顶顶顶顶？？？？顶顶

sinpa 发表于 2006-9-2 23:54:08

同意，我再。。。。。。。。。。。。。

mstiunicon 发表于 2006-9-4 09:15:48

对于这样的帖子，我只能顶！

harold 发表于 2006-9-4 10:19:12

多谢楼主的奉献精神！

lilytesting 发表于 2006-11-10 11:41:54

sdlkfj3 喜欢这样的帖子
谢谢楼主的奉献精神

minzhung 发表于 2006-12-22 15:01:44

好东西，先顶了

miniyal 发表于 2006-12-22 15:34:25

打开QTP，test--settings--resources,将附件文件添加进去就可以使用相关函数了，弱弱的问下，“附件文件”是什么东东

netsky_lt 发表于 2006-12-25 10:05:58

找了很久都没找到这样完整的，强！

weiyanmei_shui 发表于 2006-12-29 10:30:17

楼住你真是我的偶像，牛人！！！顶~~~~~

shwonder 发表于 2006-12-30 14:08:12

感谢sdlkfj2

ganlong 发表于 2007-1-6 08:38:51

好东西，先顶了,thanks

lily_mu75 发表于 2007-1-11 12:47:13

好东东！

好东东！很详细！楼主可是很专业的！谢了！

suifengpiao 发表于 2007-2-10 12:48:29

先谢了，再拷贝

htot05 发表于 2007-2-14 17:56:28

好贴~!存档,以备不时之需~~~!!!

页: [1] 2 3

51Testing软件测试论坛 's Archiver