【测试管理】如何简单的新增用例模块

直接上代码

Private Sub addmodel_Click()
    Dim str As String
    Dim hang As Integer
    Dim i As Integer
    Dim ifont As font
    Dim ifont1 As font
    
    Dim cuename As String
    str = InputBox("请输入模块名")
    
    If str = "" Then
        MsgBox ("模块名不能为空")
        
        Else
           For hang = 1 To 200
                i = hang
                If Cells(hang, 1).Value = "总计" Then
                    Rows(i).Insert Shift:=xlDown
                    Cells(i, 4).Value = str
                    
                    '新建表
                    Sheets.Add after:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = str
                    cuename = ActiveSheet.Name
                    MsgBox ("已新建一个模块用例：" + cuename)
                    
                    '新增用例
                    ActiveSheet.Rows(1).RowHeight = 70
                    ActiveSheet.Cells(1, 1) = "返回测试方案目录"
                    ActiveSheet.Columns(1).ColumnWidth = 20
                    
                                
                    
                    ActiveSheet.Cells(1, 2) = str
                    'ActiveSheet.Range("b1:j1").MergeCells = True
                    '合并并居中
                    ActiveSheet.Range("b1:f1").Select
                     With Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .IndentLevel = 0
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = False
                      End With
                      Selection.Merge
                    '修改字体
                    Set ifont1 = ActiveSheet.Range("B1").font
                    With ifont1
                    .Size = 15
                    .Bold = True
                    End With
                    
                    
                    'ActiveSheet.Cells(1, 7) = "用例标题" & vbCrLf & "我还bai没学好如du何自动关闭按ALT+F4退出吧\"
                    ActiveSheet.Cells(1, 7) = "例如模块名：保利爱家" & vbCrLf & "用例标题：blaj_001" & vbCrLf & "重要等级应填写为冒烟/关键/建议" & vbCrLf & "操作步骤：填写XXX-->{查询}"
                    Set ifont = ActiveSheet.Range("G1").font
                    With ifont
                    .Size = 10
                    .Color = vbBlue
                    End With
                                        '合并并居中
                    ActiveSheet.Range("G1:J1").Select
                     With Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .IndentLevel = 0
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = False
                      End With
                      Selection.Merge
                    
                    
                    
                    ActiveSheet.Cells(2, 1) = "用例编号"
                    ActiveSheet.Cells(2, 2) = "重要等级"
                    
                    ActiveSheet.Cells(2, 3) = "用例标题"
                    ActiveSheet.Columns(3).ColumnWidth = 20
                    
                    ActiveSheet.Cells(2, 4) = "前置条件"
                    ActiveSheet.Columns(4).ColumnWidth = 20
                    
                    ActiveSheet.Cells(2, 5) = "操作步骤"
                    ActiveSheet.Columns(5).ColumnWidth = 20
                    
                    ActiveSheet.Cells(2, 6) = "预期结果"
                    ActiveSheet.Columns(6).ColumnWidth = 20
                    
                    ActiveSheet.Cells(2, 7) = "实际结果"
                    ActiveSheet.Columns(7).ColumnWidth = 20
                    
                    ActiveSheet.Cells(2, 8) = "是否通过"
                    ActiveSheet.Cells(2, 9) = "测试人员"
                    ActiveSheet.Cells(2, 10) = "测试时间"
                    
                    
                   '返回目录
                    ActiveSheet.Range("A1").Select
                    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                    "测试方案目录!A1"
                    ActiveSheet.Range("A1").Select
                    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
                Exit For
                End If
            Next
    End If
    
    
End Sub