Нужен рабочий макрос Excel VBA, который можно использовать для сбора комментариев с информацией о местоположении как для файлов MS Word, так и для файлов Excel - PullRequest
Новая
       7

Нужен рабочий макрос Excel VBA, который можно использовать для сбора комментариев с информацией о местоположении как для файлов MS Word, так и для файлов Excel

0 голосов
/ 13 апреля 2020

Команда Мне нужна ваша помощь, чтобы создать документ Excel на основе VBA, который будет автоматически собирать все комментарии к обзору из слов или Excel с нижеприведенной базовой c информацией:

  1. Excel: Имя листа, расположение ячейки, значение ячейки и комментарии к ячейке Сходная информация, полученная для Excel, аналогичная информация для документа Word.

  2. Word: номер страницы, местоположение, Word и комментарий.

У меня есть рабочий код для первого пункта, который извлекает все комментарии из активной книги Excel со всех листов с адресами и т. Д. c. то же самое упомянуто ниже для вашей быстрой ссылки. Пожалуйста, помогите мне отредактировать этот код, который может работать аналогично для документов MS Word (номер страницы, оригинальный текст, Автор, значение комментария и т. д. c.), а также 

Sub ShowCommentsAllSheets()
    'Shantanu 20200312
    Dim commrange As Range
    Dim rng As Range
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Set newWs = Application.Worksheets.Add
    newWs.Range("A1").Resize(1, 4).Value = Array("Sheet", "Address", "Value", "Comment")
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each ws In Application.ActiveWorkbook.Worksheets
        Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
        If Not commrange Is Nothing Then
            i = newWs.Cells(Rows.Count, 1).End(xlUp).Row
            For Each rng In commrange
                i = i + 1
                newWs.Cells(i, 1).Resize(1, 4).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text)
            Next
        End If
        Set commrange = Nothing
    Next
    newWs.Cells.WrapText = False
    Application.ScreenUpdating = True
End Sub
...