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，如需转载请自行联系原作者。
![JAVA命令符找不到符号_[转]Java命令行编译文件时出现的错误，找不到符号或软件包不存在等...](http://pic.xiahunao.cn/JAVA命令符找不到符号_[转]Java命令行编译文件时出现的错误，找不到符号或软件包不存在等...)
 细说函数))
和getParameter()的区别)
![[转载] 手工制作Win7 OEM版](http://pic.xiahunao.cn/[转载] 手工制作Win7 OEM版)
