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