導出批註工具--用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
  
    綜上所述,如果還有什麼不明白的,只要運行我的附件即可清楚。

 

 

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章