QTP操作Excel的函数

最近有不少人在问QTP操作Excel的问题，其实QTP安装目录中的CodePlusSample里面就有一个名为“UsingExcel.vbs”的文件，里面有很多操作Excel的函数： 

Dim ExcellApp 'As Excel.Application

Dim excelSheet1 'As Excel.worksheet

Dim excelSheet2 'As Excel.worksheet

 

Set ExcelApp = CreateExcel()

 

'Create a workbook with two worksheets

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

ret = RenameWorksheet(ExcelApp, "Book1", "Sheet2", "Example2 Sheet Name")

ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet3")

 

'SaveAs the work book

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

 

'Fill worksheets

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

Set excelSheet2 = GetSheet(ExcelApp, "Example2 Sheet Name")

For column = 1 to 10

   For row = 1 to 10

        SetCellValue excelSheet1, row, column, row + column

        SetCellValue excelSheet2, row, column, row + column

    Next

Next

 

'Compare the two worksheets

ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False)

If ret Then

    MsgBox "The two worksheets are identical"

End If

 

'Change the values in one sheet

SetCellValue excelSheet1, 1, 1, "Yellow"

SetCellValue excelSheet2, 2, 2, "Hello"

 

'Compare the worksheets again

ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, True)

If Not ret Then

    MsgBox "The two worksheets are not identical"

End If

 

'save the workbook by index identifier

SaveWorkbook ExcelApp, 1, ""

 

'Close the Excel application

CloseExcel ExcelApp

 

' ****************************************** Function Library ***********************************************************

 

Dim ExcelApp 'As Excel.Application

Dim excelSheet 'As Excel.worksheet

Dim excelBook 'As Excel.workbook

Dim fso 'As Scripting.FileSystemObject

 

' This function will return a new Excel Object with a default new Workbook

Function CreateExcel() '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

End Function

 

'This function will close the given Excel Object

'excelApp - an Excel application object to be closed

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

 

'The SaveWorkbook method will save a workbook according to the workbookIdentifier

'The method will overwrite the previously saved file under the given path

'excelApp - a reference to the Excel Application

'workbookIdentifier - The name or number of the requested workbook

'path - the location to which the workbook should be saved

'Return "OK" on success and "Bad Workbook Identifier" on failure

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

    Dim workbook 'As Excel.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")

 

            'if the path has no file extension then add the 'xls' extension

            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

 

'The SetCellValue method sets the given 'value' in the cell which is identified by

'its row column and parent Excel sheet

'excelSheet - the excel sheet that is the parent of the requested cell

'row - the cell's row in the excelSheet

'column - the cell's column in the excelSheet

'value - the value to be set in the cell

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

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

 

'The GetSheet method returns an Excel Sheet according to the sheetIdentifier

'ExcelApp - the Excel application which is the parent of the requested sheet

'sheetIdentifier - the name or the number of the requested Excel sheet

'return Nothing on failure

Function GetSheet(ExcelApp, sheetIdentifier) 'As Excel.worksheet

    On Error Resume Next

    Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)

    On Error GoTo 0

End Function

 

'The InsertNewWorksheet method inserts an new worksheet into the active workbook or

'the workbook identified by the workbookIdentifier, the new worksheet will get a default

'name if the sheetName parameter is empty, otherwise the sheet will have the sheetName

'as a name.

'Return - the new sheet as an Object

'ExcelApp - the excel application object into which the new worksheet should be added

'workbookIdentifier - an optional identifier of the worksheet into which the new worksheet should be added

'sheetName - the optional name of the new worksheet.

Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) 'As Excel.worksheet

    Dim workbook 'As Excel.workbook

    Dim worksheet 'As Excel.worksheet

 

    'In case that the workbookIdentifier is empty we will work on the active workbook

    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)

 

    'In case that the sheetName is not empty set the new sheet's name to sheetName

    If sheetName <> "" Then

        worksheet.Name = sheetName

    End If

 

    Set InsertNewWorksheet = worksheet

End Function

 

'The RenameWorksheet method renames a worksheet's name

'ExcelApp - the excel application which is the worksheet's parent

'workbookIdentifier - the worksheet's parent workbook identifier

'worksheetIdentifier - the worksheet's identifier

'sheetName - the new name for the worksheet

Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) 'As String

    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

        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

 

'The RemoveWorksheet method removes a worksheet from a workbook

'ExcelApp - the excel application which is the worksheet's parent

'workbookIdentifier - the worksheet's parent workbook identifier

'worksheetIdentifier - the worksheet's identifier

Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) 'As String

    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

 

'The CreateNewWorkbook method creates a new workbook in the excel application

'ExcelApp - the Excel application to which an new Excel workbook will be added

Function CreateNewWorkbook(ExcelApp)

    Set NewWorkbook = ExcelApp.Workbooks.Add()

    Set CreateNewWorkbook = NewWorkbook

End Function

 

'The OpenWorkbook method opens a previously saved Excel workbook and adds it to the Application

'excelApp - the Excel Application the workbook will be added to

'path - the path of the workbook that will be opened

'return Nothing on failure

Function OpenWorkbook(ExcelApp, path)

    On Error Resume Next

    Set NewWorkbook = ExcelApp.Workbooks.Open(path)

    Set OpenWorkbook = NewWorkbook

    On Error GoTo 0

End Function

 

'The ActivateWorkbook method sets one of the workbooks in the application as Active workbook

'ExcelApp - the workbook's parent excel Application

'workbookIdentifier - the name or the number of the workbook

Sub ActivateWorkbook(ExcelApp, workbookIdentifier)

    On Error Resume Next

    ExcelApp.Workbooks(workbookIdentifier).Activate

    On Error GoTo 0

End Sub

 

'The CloseWorkbook method closes an open workbook

'ExcelApp - the parent Excel application of the workbook

'workbookIdentifier - the name or the number of the workbook

Sub CloseWorkbook(ExcelApp, workbookIdentifier)

    On Error Resume Next

    ExcelApp.Workbooks(workbookIdentifier).Close

    On Error GoTo 0

End Sub

 

'The CompareSheets method compares between two sheets.

'if there is a difference between the two sheets then the value in the second sheet

'will be changed to red and contain the string:

'"Compare conflict - Value was 'Value2', Expected value is 'value2'"

'sheet1, sheet2 - the excel sheets to be compared

'startColumn - the column to start comparing in the two sheets

'numberOfColumns - the number of columns to be compared

'startRow - the row to start comparing in the two sheets

'numberOfRows - the number of rows to be compared

Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed) 'As Boolean

    Dim returnVal 'As Boolean

    returnVal = True

 

    'In case that one of the sheets doesn't exists, don't continue the process

    If sheet1 Is Nothing Or sheet2 Is Nothing Then

        CompareSheets = False

        Exit Function

    End If

 

    'loop through the table and fill values into the two worksheets

    For r = startRow to (startRow + (numberOfRows - 1))

        For c = startColumn to (startColumn + (numberOfColumns - 1))

            Value1 = sheet1.Cells(r, c)

            Value2 = sheet2.Cells(r, c)

 

            'if 'trimed' equels True then used would like to ignore blank spaces

            If trimed Then

                Value1 = Trim(Value1)

                Value2 = Trim(Value2)

            End If

 

            'in case that the values of a cell are not equel in the two worksheets

            'create an indicator that the values are not equel and set return value

            'to False

            If Value1 <> Value2 Then

                Dim cell 'As Excel.Range

                sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'."

                Set cell = sheet2.Cells(r, c)

                cell.Font.Color = vbRed

                returnVal = False

            End If

        Next

    Next

    CompareSheets = returnVal

End Function