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

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

		自动登录	找回密码
密码			(注-册)加入51Testing

[原创] QuickTest Plus帮助文档中EXCEL相关函数

本帖子中包含更多资源

相关帖子

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

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

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

好东东！

站长推荐 /1