导出批注工具--用VBA脚本导出Excel评审文档的所有批注

1、先给出原始excel文件，例如

  

2、本文工具将针对上述的评审文档，导出所有批注，且将批注生成一个新的sheet页，该sheet页跟评审文档在同一个文档中，如下格式：

3、生成如上的结果，只需要如下代码即可：

       '打开Excel文件，找寻工作表的名字为“*用例”，并导出工工作表的所有批注，
    '将这些批注生成到一个新的sheet页中
    '同时并记录修改时间
    Sub exportComments_Click()
       
        Dim filename As String  '目标文件名（包含路径）
        Dim sht As Worksheet    '定义的临时工资表变量
        Dim i, j As Integer
        Dim txt As String
        i = 1
       
        '获取选择中文件的名字
        filename = Application.GetOpenFilename
        Workbooks.Open filename '打开选择的文件
       
        '获取所有名字为"*用例*"的sheet
        For Each sht In ActiveWorkbook.Sheets
           If InStr(1, sht.Name, "用例") Then
             '读取选择文件的所有批注到新的sheet
             '该sheet页名称为“用例评审批注”
             Worksheets.Add().Name = "用例评审批注"
             '设置首行的样式
             setFirstRowStyle
            
             '设置首行的列标题
             ActiveSheet.Cells(1, "A").Value = "序号"
             ActiveSheet.Cells(1, "B").Value = "批注所在位置"
             ActiveSheet.Cells(1, "C").Value = "批注生成时间"
             ActiveSheet.Cells(1, "D").Value = "评审人员"
             ActiveSheet.Cells(1, "E").Value = "批注内容"
             '遍历“用例”sheet页的所有注释
             For Each Cmt In sht.Comments
                i = i + 1
                j = InStr(1, Cmt.Text, Chr(10))
                ActiveSheet.Cells(i, "A").Value = i - 1
                ActiveSheet.Cells(i, "C").Value = Date
                ActiveSheet.Cells(i, "D").Value = Mid(Cmt.Text, 1, j - 2)
                ActiveSheet.Cells(i, "E").Value = Mid(Cmt.Text, j + 1)
                ActiveSheet.Cells(i, "B").Value = "(" + getCellRow(Cmt.Parent.address) + "," + getCellColumn(Cmt.Parent.address) + ")"
             Next
            
             ActiveWorkbook.Save
             'MsgBox (sht.Name)
           End If
          
         Next
        ActiveWorkbook.Close
   
    End Sub
     '设置首行的样式
    Sub setFirstRowStyle()
        ActiveSheet.Range("A1:A188").Select
        Selection.HorizontalAlignment = Excel.xlLeft
       
        ActiveSheet.Range("C1:C188").Select
        Selection.HorizontalAlignment = Excel.xlLeft
       
        Range("A1:E1").Interior.ColorIndex = 4
        Range("B1:F1").ColumnWidth = 15
        Range("E1").ColumnWidth = 60
        Range("A1").ColumnWidth = 9
       
    End Sub
   
   
    ' 获取注释所在的列号
    Function getCellColumn(address As String)
      Dim i1 As Integer
      Dim i2 As Integer
      i1 = InStr(address, "$")
      i2 = InStrRev(address, "$")
      getCellColumn = Mid(address, i1 + 1, i2 - i1 - 1)
     
    End Function
    
   
     ' 获取注释所在的行号
    Function getCellRow(address As String)
      Dim i As Integer
      Dim s As String
      i = InStrRev(address, "$")
      getCellRow = Mid(address, i + 1)
     
    End Function
  
    综上所述，如果还有什么不明白的，只要运行我的附件即可清楚。