首页 > 代码库 > word检视意见导出(VBA)

word检视意见导出(VBA)

Private Sub CommandButton1_Click()    Dim Cmt As Comment    Dim excelApp As Object    Dim xlsWbk, objWdApp As Object    Dim commentsArray    Dim rows, temp, i, x, y As Integer    Dim filename As String    Dim myWDoc As Word.Document        Dim authorName As String        获取选择中文件的名字    filename = Application.GetOpenFilename    If filename = "False" Then        Exit Sub    End If            Set objWdApp = CreateObject("word.application")    objWdApp.Visible = False 隐式打开    Set mywdoc = objWdApp.Documents.Open(filename)        temp = 0    x = 12    y = 12        rows = mywdoc.Comments.Count    ReDim commentsArray(1 To rows, 1 To 4)        If rows = 0 Then        MsgBox "没有批注!"    End If        With Worksheets(1)        Do While .Cells(x, 1) <> ""            x = x + 1        Loop                If x > 12 Then            y = x            x = .Cells(x - 1, 1)        Else            x = 0        End If    End With        For i = 1 To rows        temp = temp + 1
     x = x + 1

序号 commentsArray(temp, 1) = x
批注引用的内容 commentsArray(temp, 2) = mywdoc.Comments(i).Scope 批注内容 commentsArray(temp, 3) = mywdoc.Comments(i).Range 页/行 commentsArray(temp, 4) = "在第" & mywdoc.Comments(i).Scope.Information(3) & "页第" & mywdoc.Comments(i).Scope.Information(10) & "" 作者 authorName = mywdoc.Comments(i).Author Next
Worksheets(
1).Cells(2, 2) = mywdoc.Name Worksheets(1).Cells(3, 2) = authorName mywdoc.BuiltinDocumentProperties (14) 获取总页数 With Worksheets(1) .Range("A" & y).Resize(rows, 4) = commentsArray .Columns.AutoFit End With mywdoc.Application.QuitEnd SubPrivate Sub CommandButton2_Click() Worksheets(1).Range("A12").Resize(200, 4) = "" Worksheets(1).Cells(2, 2) = "" Worksheets(1).Cells(3, 2) = "" End Sub


界面

 

word检视意见导出(VBA)