1:  QTP Excel函數 操作EXCEL 數據表格 表單 編輯EXCEL 工作表

   2:  Dim ExcelApp    'As Excel.Application

   3:  Dim excelSheet 'As Excel.worksheet

   4:  Dim excelBook   'As Excel.workbook

   5:  Dim fso         'As scrīpting.FileSystemObject

   6:  ?

   7:  ' *********************************************************************************************

   8:  ' 函數說明：創建一個Excel應用程序ExcelApp,并創建一個新的工作薄Workbook;

   9:  ' 參數說明：無

  10:  ' 調用方法:

  11:  '           CreateExcel()

  12:  ' *********************************************************************************************

  13:  ?

  14:  Function CreateExcel()

  15:      Dim excelSheet

  16:      Set ExcelApp = CreateObject("Excel.Application")

  17:      ExcelApp.Workbooks.Add

  18:      ExcelApp.Visible = True

  19:      Set CreateExcel = ExcelApp

  20:  End Function

  21:  ?

  22:  ' *********************************************************************************************

  23:  ' 函數說明：關閉Excel應用程序;

  24:  ' 參數說明：

  25:  '          (1)ExcelApp:Excel應用程序名稱;

  26:  ' 調用方法:

  27:  '           CloseExcel(ExcelApp)

  28:  ' *********************************************************************************************

  29:  Sub CloseExcel(ExcelApp)

  30:      Set excelSheet = ExcelApp.ActiveSheet

  31:      Set excelBook = ExcelApp.ActiveWorkbook

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

  33:      On Error Resume Next

  34:      fso.CreateFolder "C:\Temp"

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

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

  37:      ExcelApp.Quit

  38:      Set ExcelApp = Nothing

  39:      Set fso = Nothing

  40:      Err = 0

  41:      On Error GoTo 0

  42:  End Sub

  43:  ?

  44:  ' *********************************************************************************************

  45:  ' 函數說明：保存工作薄;

  46:  ' 參數說明：

  47:  '          (1)ExcelApp:Excel應用程序名稱;

  48:  '          (2)workbookIdentifier:屬于ExcelApp的工作薄名稱;

  49:  '          (3)path:保存的路徑;

  50:  ' 返回結果：

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

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

  53:  ' 調用方法:

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

  55:  ' *********************************************************************************************

  56:  ?

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

  58:      Dim workbook

  59:      On Error Resume Next '啟用錯誤處理程序

  60:      Set workbook = ExcelApp.Workbooks(workbookIdentifier)

  61:      On Error GoTo 0   '禁用錯誤處理程序

  62:  ?

  63:      If Not workbook Is Nothing Then

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

  65:              workbook.Save

  66:          Else

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

  68:  ?

  69:              '判斷路徑中是否已添加擴展名.xls

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

  71:                  path = path & ".xls"

  72:              End If

  73:  ?

  74:              '刪除路徑下現有同名的文件

  75:              On Error Resume Next

  76:              fso.DeleteFile path

  77:              Set fso = Nothing

  78:              Err = 0

  79:              On Error GoTo 0

  80:            

  81:              workbook.SaveAs path

  82:          End If

  83:          SaveWorkbook = "OK"

  84:      Else

  85:          SaveWorkbook = "Bad Workbook Identifier"

  86:      End If

  87:  End Function

  88:  ?

  89:  ' *********************************************************************************************

  90:  ' 函數說明：設置工作表excelSheet單元格的值

  91:  ' 參數說明：

  92:  '          (1)excelSheet:工作表名稱;

  93:  '          (2)row:列的序號,第一列為1;

  94:  '          (3)column:行的序號,第一行為1;

  95:  '          (4)value:單元格要設置的值;

  96:  ' 返回結果：

  97:  '          無返回值

  98:  ' 調用方法:

  99:  '           SetCellValue excelSheet1, 1, 2, "test"

 100:  ' *********************************************************************************************

 101:  ?

 102:  Sub SetCellValue(excelSheet, row, column, value)

 103:      On Error Resume Next

 104:      excelSheet.Cells(row, column) = value

 105:      On Error GoTo 0

 106:  End Sub

 107:  ?

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

 109:  'excelSheet - the Excel Sheet in which the cell exists

 110:  'row - the cell's row

 111:  'column - the cell's column

 112:  'return 0 if the cell could not be found

 113:  ' *********************************************************************************************

 114:  ' 函數說明：獲取工作表excelSheet單元格的值

 115:  ' 參數說明：

 116:  '          (1)excelSheet:工作表名稱;

 117:  '          (2)row:列的序號;

 118:  '          (3)column:行的序號;

 119:  ' 返回結果：

 120:  '          (1)單元格存在,返回單元格值;

 121:  '          (2)單元格不存在，返回0;

 122:  ' 調用方法:

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

 124:  ' *********************************************************************************************

 125:  ?

 126:  Function GetCellValue(excelSheet, row, column)

 127:      value = 0

 128:      Err = 0

 129:      On Error Resume Next

 130:      tempValue = excelSheet.Cells(row, column)

 131:      If Err = 0 Then

 132:          value = tempValue

 133:          Err = 0

 134:      End If

 135:      On Error GoTo 0

 136:      GetCellValue = value

 137:  End Function

 138:  ?

 139:  ' *********************************************************************************************

 140:  ' 函數說明：獲取并返回工作表對象

 141:  ' 參數說明：

 142:  '          (1)ExcelApp:Excel應用程序名稱;

 143:  '          (2)sheetIdentifier:屬于ExcelApp的工作表名稱;

 144:  ' 返回結果：

 145:  '          (1)成功：工作表對象Excel.worksheet

 146:  '          (1)失敗：Nothing

 147:  ' 調用方法:

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

 149:  ' *********************************************************************************************

 150:  ?

 151:  Function GetSheet(ExcelApp, sheetIdentifier)

 152:      On Error Resume Next

 153:      Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)

 154:      On Error GoTo 0

 155:  End Function

 156:  ?

 157:  ' *********************************************************************************************

 158:  ' 函數說明：添加一張新的工作表

 159:  ' 參數說明：

 160:  '          (1)ExcelApp:Excel應用程序名稱;

 161:  '          (2)workbookIdentifier:屬于ExcelApp的工作薄名稱;

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

 163:  ' 返回結果：

 164:  '          (1)成功：工作表對象worksheet

 165:  '          (1)失敗：Nothing

 166:  ' 調用方法:

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

 168:  ' *********************************************************************************************

 169:  ?

 170:  Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName)

 171:      Dim workbook 'As Excel.workbook

 172:      Dim worksheet 'As Excel.worksheet

 173:  ?

 174:      '如果指定的工作薄不存在，將在當前激活狀態的工作表中添加工作表

 175:      If workbookIdentifier = "" Then

 176:          Set workbook = ExcelApp.ActiveWorkbook

 177:      Else

 178:          On Error Resume Next

 179:          Err = 0

 180:          Set workbook = ExcelApp.Workbooks(workbookIdentifier)

 181:          If Err <> 0 Then

 182:              Set InsertNewWorksheet = Nothing

 183:              Err = 0

 184:              Exit Function

 185:          End If

 186:          On Error GoTo 0

 187:      End If

 188:  ?

 189:      sheetCount = workbook.Sheets.Count '獲取工作薄中工作表的數量

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

 191:      Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet為新添加的工作表對象

 192:  ?

 193:      '設置新添加的工作表名稱

 194:      If sheetName <> "" Then

 195:          worksheet.Name = sheetName

 196:      End If

 197:  ?

 198:      Set InsertNewWorksheet = worksheet

 199:  End Function

 200:  ?

 201:  ' *********************************************************************************************

 202:  ' 函數說明：修改工作表的名稱;

 203:  ' 參數說明：

 204:  '          (1)ExcelApp:Excel應用程序名稱;

 205:  '          (2)workbookIdentifier:屬于ExcelApp的工作薄名稱;

 206:  '          (3)worksheetIdentifier:屬于workbookIdentifier工作薄的工作表名稱;

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

 208:  ' 返回結果：

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

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

 211:  ' 調用方法:

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

 213:  ' *********************************************************************************************

 214:  ?

 215:  Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName)

 216:      Dim workbook

 217:      Dim worksheet

 218:      On Error Resume Next

 219:      Err = 0

 220:      Set workbook = ExcelApp.Workbooks(workbookIdentifier)

 221:      If Err <> 0 Then

 222:          RenameWorksheet = "Bad Workbook Identifier"

 223:          Err = 0

 224:          Exit Function

 225:      End If

 226:      Set worksheet = workbook.Sheets(worksheetIdentifier)

 227:      If Err <> 0 Then

 228:          RenameWorksheet = "Bad Worksheet Identifier"

 229:          Err = 0

 230:          Exit Function

 231:      End If

 232:      worksheet.Name = sheetName

 233:      RenameWorksheet = "OK"

 234:  End Function

 235:  ?

 236:  ' *********************************************************************************************

 237:  ' 函數說明：刪除工作表;

 238:  ' 參數說明：

 239:  '          (1)ExcelApp:Excel應用程序名稱;

 240:  '          (2)workbookIdentifier:屬于ExcelApp的工作薄名稱;

 241:  '          (3)worksheetIdentifier:屬于workbookIdentifier工作薄的工作表名稱;

 242:  ' 返回結果：

 243:  '          (1)刪除成功，返回字符串：OK

 244:  '          (2)刪除失敗，返回字符串：Bad Worksheet Identifier

 245:  ' 調用方法:

 246:  '           set ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet1")

 247:  ' *********************************************************************************************

 248:  ?

 249:  Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier)

 250:      Dim workbook 'As Excel.workbook

 251:      Dim worksheet 'As Excel.worksheet

 252:      On Error Resume Next

 253:      Err = 0

 254:      Set workbook = ExcelApp.Workbooks(workbookIdentifier)

 255:      If Err <> 0 Then

 256:          RemoveWorksheet = "Bad Workbook Identifier"

 257:          Exit Function

 258:      End If

 259:      Set worksheet = workbook.Sheets(worksheetIdentifier)

 260:      If Err <> 0 Then

 261:          RemoveWorksheet = "Bad Worksheet Identifier"

 262:          Exit Function

 263:      End If

 264:      worksheet.Delete

 265:      RemoveWorksheet = "OK"

 266:  End Function

 267:  ?

 268:  ' *********************************************************************************************

 269:  ' 函數說明：添加新的工作薄

 270:  ' 參數說明：

 271:  '          (1)ExcelApp:Excel應用程序名稱;

 272:  ' 返回結果：

 273:  '          (1)成功：工作表對象NewWorkbook

 274:  '          (1)失敗：Nothing

 275:  ' 調用方法:

 276:  '          set NewWorkbook = CreateNewWorkbook(ExcelApp)

 277:  ' *********************************************************************************************

 278:  ?

 279:  Function CreateNewWorkbook(ExcelApp)

 280:      Set NewWorkbook = ExcelApp.Workbooks.Add()

 281:      Set CreateNewWorkbook = NewWorkbook

 282:  End Function

 283:  ?

 284:  ' *********************************************************************************************

 285:  ' 函數說明：打開工作薄

 286:  ' 參數說明：

 287:  '          (1)ExcelApp:Excel應用程序名稱;

 288:  '          (2)path:要打開的工作薄路徑;

 289:  ' 返回結果：

 290:  '          (1)成功：工作表對象NewWorkbook

 291:  '          (1)失敗：Nothing

 292:  ' 調用方法:

 293:  '          set NewWorkbook = CreateNewWorkbook(ExcelApp)

 294:  ' *********************************************************************************************

 295:  ?

 296:  Function OpenWorkbook(ExcelApp, path)

 297:      On Error Resume Next

 298:      Set NewWorkbook = ExcelApp.Workbooks.Open(path)

 299:      Set ōpenWorkbook = NewWorkbook

 300:      On Error GoTo 0

 301:  End Function

 302:  ?

 303:  ' *********************************************************************************************

 304:  ' 函數說明：將工作薄設置為當前工作狀態

 305:  ' 參數說明：

 306:  '          (1)ExcelApp:Excel應用程序名稱;

 307:  '          (2)workbookIdentifier:要設置為當前工作狀態的工作薄名稱;

 308:  ' 返回結果：無返回值;

 309:  ' 調用方法:

 310:  '          ActivateWorkbook(ExcelApp, workbook1)

 311:  ' *********************************************************************************************

 312:  ?

 313:  Sub ActivateWorkbook(ExcelApp, workbookIdentifier)

 314:      On Error Resume Next

 315:      ExcelApp.Workbooks(workbookIdentifier).Activate

 316:      On Error GoTo 0

 317:  End Sub

 318:  ?

 319:  ' *********************************************************************************************

 320:  ' 函數說明：關閉Excel工作薄;

 321:  ' 參數說明：

 322:  '          (1)ExcelApp:Excel應用程序名稱;

 323:  '          (2)workbookIdentifier:

 324:  ' 調用方法:

 325:  '           CloseWorkbook(ExcelApp, workbookIdentifier)

 326:  ' *********************************************************************************************

 327:  ?

 328:  Sub CloseWorkbook(ExcelApp, workbookIdentifier)

 329:      On Error Resume Next

 330:      ExcelApp.Workbooks(workbookIdentifier).Close

 331:      On Error GoTo 0

 332:  End Sub

 333:  ?

 334:  ' *********************************************************************************************

 335:  ' 函數說明：判斷兩個工作表對應單元格內容是否相等

 336:  ' 參數說明：

 337:  '          (1)sheet1:工作表1的名稱;

 338:  '          (2)sheet2:工作表2的名稱;

 339:  '          (3)startColumn:開始比較的行序號;

 340:  '          (4)numberOfColumns:要比較的行數;

 341:  '          (5)startRow:開始比較的列序號;

 342:  '          (6)numberOfRows:要比較的列數;

 343:  '          (7)trimed:是否先除去字符串開始的空格和尾部空格后再進行比較,true或flase;

 344:  ' 返回結果：

 345:  '          (1)兩工作表對應單元格內容相等：true

 346:  '          (2)兩工作表對應單元格內容不相等:flase       

 347:  ' 調用方法:

 348:  '           ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False)

 349:  ' *********************************************************************************************

 350:  ?

 351:  Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed)

 352:      Dim returnVal 'As Boolean

 353:      returnVal = True

 354:  ?

 355:      '判斷兩個工作表是否都存在,任何一個不存在停止判斷，返回flase

 356:      If sheet1 Is Nothing Or sheet2 Is Nothing Then

 357:          CompareSheets = False

 358:          Exit Function

 359:      End If

 360:  ?

 361:      '循環判斷兩個工作表單元格的值是否相等

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

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

 364:              Value1 = sheet1.Cells(r, c)

 365:              Value2 = sheet2.Cells(r, c)

 366:  ?

 367:              '如果trimed為true,去除單元格內容前面和尾部空格

 368:              If trimed Then

 369:                  Value1 = Trim(Value1)

 370:                  Value2 = Trim(Value2)

 371:              End If

 372:  ?

 373:              '如果單元格內容不一致,函數返回flase

 374:              If Value1 <> Value2 Then

 375:                  Dim cell 'As Excel.Range

 376:                  '修改sheet2工作表中對應單元格值

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

 378:                  '初始化cell為sheet2中r:c單元格對象

 379:                  Set cell = sheet2.Cells(r, c) '

 380:                  '將sheet2工作表中對應單元格的顏色設置為紅色

 381:                  cell.Font.Color = vbRed

 382:                  returnVal = False

 383:              End If

 384:          Next

 385:      Next

 386:      CompareSheets = returnVal

 387:  End Function

388: ?

本文轉自hcy's workbench博客園博客，原文鏈接：http://www.cnblogs.com/alterhu/archive/2011/12/29/2306014.html，如需轉載請自行聯系原作者。