Excel 在测试中的应用(二)--添加功能键

下面我们看下如何添加功能键。

如果看不到开发选项，请在文件--》开发者选项中勾选显示开发项就行。

直接选择button放置对应位置。

 

先来看第一个show/hide Test cases按钮用来显示或者隐藏详细案例

Vba代码  

1. Sub ShowTestCases()   
2. Dim TestCases As Range   
3. Set TestCases = Range("RangeTestCases")   
4. If TestCases.EntireColumn.Hidden = True Then   
5.    TestCases.EntireColumn.Hidden = False   
6.    ActiveSheet.Outline.ShowLevels RowLevels:=5  
7.    Else   
8.    TestCases.EntireColumn.Hidden = True   
9.    ActiveSheet.Outline.ShowLevels RowLevels:=2  
10.    End If   
11.       
12. End Sub  

Sub ShowTestCases()Dim TestCases As RangeSet TestCases = Range("RangeTestCases")If TestCases.EntireColumn.Hidden = True Then   TestCases.EntireColumn.Hidden = False   ActiveSheet.Outline.ShowLevels RowLevels:=5   Else   TestCases.EntireColumn.Hidden = True   ActiveSheet.Outline.ShowLevels RowLevels:=2   End If   End Sub

 设置好要隐藏或者显示区域即range。

Vba代码  

1. Sub ShowDifferentLevel()   
2. Dim TestCases As Range   
3. Set TestCases = Range("RangeTestCases")   
4. If Range("B4").Value = 0 Then   
5.    Range("B4").Value = 1  
6.    TestCases.EntireColumn.Hidden = True   
7.    ActiveSheet.Outline.ShowLevels RowLevels:=3  
8.    Else   
9.    TestCases.EntireColumn.Hidden = True   
10.    ActiveSheet.Outline.ShowLevels RowLevels:=2  
11.    Range("B4").Value = 0  
12.    End If   
13. End Sub  

Sub ShowDifferentLevel()Dim TestCases As RangeSet TestCases = Range("RangeTestCases")If Range("B4").Value = 0 Then   Range("B4").Value = 1   TestCases.EntireColumn.Hidden = True   ActiveSheet.Outline.ShowLevels RowLevels:=3   Else   TestCases.EntireColumn.Hidden = True   ActiveSheet.Outline.ShowLevels RowLevels:=2   Range("B4").Value = 0   End IfEnd Sub

 

这里对应的就是outline.show levels。也就是在界面上点1 2 3等不同的级别，可通过上面代码设置

Vba代码  

1. Sub SendMail()   
2. Dim BankNum As String   
3. Dim BankName As String   
4. Dim MyDate As String   
5. Dim m   
6. Dim n   
7. Dim Address1, Address2, ResultAddress, ResultAddress2   
8. n = 0  
9. MyDate = Date   
10. BankNum = Sheet1.Range("BankNum").Value   
11. BankName = Sheet1.Range("BankName").Value   
12. Sheet2.Range("A3").Value = "$D$4"  
13. Sheet2.Range("D4:D200").EntireRow.Delete   
14. For m = 10 To 953  
15.  If Sheet1.Cells(m, 13).Value = "失败" Then   
16.  Sheet2.Range("A1").Value = Split(Sheet1.Cells(m, 13).MergeArea.Address, ":")(1)   
17.  Sheet2.Range("A2").Value = Sheet1.Cells(m, 5).Address   
18.     Address1 = Sheet2.Range("A1").Value   
19.     Address2 = Sheet2.Range("A2").Value   
20.     ResultAddress = Address1 + ":" + Address2   
21.     ResultAddress2 = Sheet2.Range("A3").Value   
22.     Sheet1.Range(ResultAddress).Copy   
23.     ActiveSheet.Paste Destination:=Sheet2.Range(ResultAddress2).Offset(1, 0)   
24.     Sheet2.Range("A3").Value = Split(Sheet2.Range(ResultAddress2).Offset(1, 0).MergeArea.Address, ":")(1)   
25.     ResultAddress2 = Sheet2.Range("A3").Value   
26.     n = n + 1  
27.     End If   
28. Next   
29. ActiveSheet.Outline.ShowLevels RowLevels:=2  
30. Range("RangeTestCases").EntireColumn.Hidden = True   
31. Application.ThisWorkbook.Save   
32. MsgBox "please select  'No'  when Microsoft Excel dialog box asks if you want to share this workbook and changes have been saved automatically"  
33.     ActiveWorkbook.SendForReview _   
34.         Recipients:="[e-mail]", _   
35.         Subject:=BankName + "(机构代码" + BankNum + ")" + "测试运行报告" + "_" + MyDate, _   
36.         ShowMessage:=True, _   
37.         IncludeAttachment:=True   
38.   
39. End Sub  

Sub SendMail()Dim BankNum As StringDim BankName As StringDim MyDate As StringDim mDim nDim Address1, Address2, ResultAddress, ResultAddress2n = 0MyDate = DateBankNum = Sheet1.Range("BankNum").ValueBankName = Sheet1.Range("BankName").ValueSheet2.Range("A3").Value = "$D$4"Sheet2.Range("D4:D200").EntireRow.DeleteFor m = 10 To 953 If Sheet1.Cells(m, 13).Value = "失败" Then Sheet2.Range("A1").Value = Split(Sheet1.Cells(m, 13).MergeArea.Address, ":")(1) Sheet2.Range("A2").Value = Sheet1.Cells(m, 5).Address    Address1 = Sheet2.Range("A1").Value    Address2 = Sheet2.Range("A2").Value    ResultAddress = Address1 + ":" + Address2    ResultAddress2 = Sheet2.Range("A3").Value    Sheet1.Range(ResultAddress).Copy    ActiveSheet.Paste Destination:=Sheet2.Range(ResultAddress2).Offset(1, 0)    Sheet2.Range("A3").Value = Split(Sheet2.Range(ResultAddress2).Offset(1, 0).MergeArea.Address, ":")(1)    ResultAddress2 = Sheet2.Range("A3").Value    n = n + 1    End IfNextActiveSheet.Outline.ShowLevels RowLevels:=2Range("RangeTestCases").EntireColumn.Hidden = TrueApplication.ThisWorkbook.SaveMsgBox "please select  'No'  when Microsoft Excel dialog box asks if you want to share this workbook and changes have been saved automatically"    ActiveWorkbook.SendForReview _        Recipients:="[e-mail]", _        Subject:=BankName + "(机构代码" + BankNum + ")" + "测试运行报告" + "_" + MyDate, _        ShowMessage:=True, _        IncludeAttachment:=TrueEnd Sub

 上面也就是发送邮件功能，中间应该加上application.updatescreen=false 防止在发送过程中弹出对话框，还可做另外一点优化就是只发送测试统计结果而不发送测试案例。简单的设置一下应该就可以完成。

    ActiveWorkbook.SendForReview _
        Recipients:="[e-mail]", _
        Subject:=BankName + "(机构代码" + BankNum + ")" + "测试运行报告" + "_" + MyDate, _
        ShowMessage:=True, _
        IncludeAttachment:=True

分别设置邮件主题、收件人、是否包括附件、显示信息等。

Vba代码  

1. Sub ResetTestResult()   
2. Dim i   
3. Dim Msg, Style, Title, Help, Ctxt, Response, MyString   
4. Msg = "Are you sure you want to clean record results? (You can do this unless you want to test a new orgination or aband previous test results)"    ' Define message.   
5. Style = vbYesNo   ' Define buttons.   
6. Title = "Clean Result"    ' Define title.   ' Define Help file.   
7. Response = MsgBox(Msg, Style, Title)   
8. If Response = vbYes Then    ' User chose Yes.   
9.    For i = 10 To 950  
10.  If Sheet1.Cells(i, 13).Value <> "" Then   
11.     Sheet1.Cells(i, 13).Value = "未测试"  
12.  End If   
13. Next   
14. Sheet1.Range("BankNum").Value = ""  
15. Sheet1.Range("BankName").Value = ""  
16. Sheet1.Range("N7:P954").ClearContents   
17. Sheet2.Range("D4:D200").EntireRow.Delete   
18. MsgBox "All results cleared"  
19. End If   
20.   
21.   
22. End Sub  

Sub ResetTestResult()Dim iDim Msg, Style, Title, Help, Ctxt, Response, MyStringMsg = "Are you sure you want to clean record results? (You can do this unless you want to test a new orgination or aband previous test results)"    ' Define message.Style = vbYesNo   ' Define buttons.Title = "Clean Result"    ' Define title.   ' Define Help file.Response = MsgBox(Msg, Style, Title)If Response = vbYes Then    ' User chose Yes.   For i = 10 To 950 If Sheet1.Cells(i, 13).Value <> "" Then    Sheet1.Cells(i, 13).Value = "未测试" End IfNextSheet1.Range("BankNum").Value = ""Sheet1.Range("BankName").Value = ""Sheet1.Range("N7:P954").ClearContentsSheet2.Range("D4:D200").EntireRow.DeleteMsgBox "All results cleared"End IfEnd Sub

 

最后一步即清除运行记录结果，考虑到需要重复使用，所以加入此功能。

其实还可以将运行失败的案例单独提出另存一个sheet。也便于测试跟踪和汇报。