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

Найти столбец, связанный с комментариями, содержащимися в ячейке таблицы MS Word

0 голосов
/ 23 марта 2020

У меня есть документ Word, содержащий таблицу с двумя столбцами

столбец 1 содержит числа

столбец 2 содержит текст

Пользователи вводят комментарии к тексту в столбце 2 ( см. рисунок).

Я могу создать таблицу, объединяющую все комментарии с этим кодом .

Как получить доступ к номеру другого столбца со ссылкой на тексты прокомментировали? enter image description here

Результат пока такой:
enter image description here Мне нужен номер в первом столбце рядом с текстом, содержащим комментарий .

Я предполагаю, что есть метод, похожий на: 

oDoc.Comments(n).Scope.Information(wdActiveEndPageNumber)

, но доступ к ячейке таблицы - и тогда я мог бы обратиться к той же строке и первому столбцу, чтобы получить содержимое первого столбец?

Ниже приведен код, который создает таблицу выше. Имейте в виду, что в коде не учитываются комментарии к тексту, принадлежащему ячейкам таблицы, что я и ищу. 

Sub ExtractCommentsToNewDocument()

    '=========================
    'Macro created 2007 by Lene Fredborg, DocTools - www.thedoctools.com
    'Revised October 2013 by Lene Fredborg: Date column added to extract
    'THIS MACRO IS COPYRIGHT. YOU ARE WELCOME TO USE THE MACRO BUT YOU MUST KEEP THE LINE ABOVE.
    'YOU ARE NOT ALLOWED TO PUBLISH THE MACRO AS YOUR OWN, IN WHOLE OR IN PART.
    '=========================
    'The macro creates a new document
    'and extracts all comments from the active document
    'incl. metadata

    'Minor adjustments are made to the styles used
    'You may need to change the style settings and table layout to fit your needs
    '=========================

    Dim oDoc As Document
    Dim oNewDoc As Document
    Dim oTable As Table
    Dim nCount As Long
    Dim n As Long
    Dim Title As String

    Title = "Extract All Comments to New Document"
    Set oDoc = ActiveDocument
    nCount = ActiveDocument.Comments.Count

    If nCount = 0 Then
        MsgBox "The active document contains no comments.", vbOKOnly, Title
        GoTo ExitHere
    Else
        'Stop if user does not click Yes
        If MsgBox("Do  you want to extract all comments to a new document?", _
                vbYesNo + vbQuestion, Title) <> vbYes Then
            GoTo ExitHere
        End If
    End If

    Application.ScreenUpdating = False
    'Create a new document for the comments, base on Normal.dot
    Set oNewDoc = Documents.Add
    'Set to landscape
    oNewDoc.PageSetup.Orientation = wdOrientLandscape
    'Insert a 4-column table for the comments
    With oNewDoc
        .Content = ""
        Set oTable = .Tables.Add _
            (range:=Selection.range, _
            NumRows:=nCount + 1, _
            NumColumns:=5)
    End With

    'Insert info in header - change date format as you wish
    oNewDoc.Sections(1).Headers(wdHeaderFooterPrimary).range.Text = _
        "Comments extracted from: " & oDoc.FullName & vbCr & _
        "Created by: " & Application.UserName & vbCr & _
        "Creation date: " & Format(Date, "MMMM d, yyyy")

    'Adjust the Normal style and Header style
    With oNewDoc.Styles(wdStyleNormal)
        .Font.Name = "Arial"
        .Font.Size = 10
        .ParagraphFormat.LeftIndent = 0
        .ParagraphFormat.SpaceAfter = 6
    End With

    With oNewDoc.Styles(wdStyleHeader)
        .Font.Size = 8
        .ParagraphFormat.SpaceAfter = 0
    End With

    'Format the table appropriately
    With oTable
        .range.Style = wdStyleNormal
        .AllowAutoFit = False
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        .Columns.PreferredWidthType = wdPreferredWidthPercent
        .Columns(1).PreferredWidth = 5
        .Columns(2).PreferredWidth = 23
        .Columns(3).PreferredWidth = 42
        .Columns(4).PreferredWidth = 18
        .Columns(5).PreferredWidth = 12
        .Rows(1).HeadingFormat = True
    End With

    'Insert table headings
    With oTable.Rows(1)
        .range.Font.Bold = True
        .Cells(1).range.Text = "Page"
        .Cells(2).range.Text = "Code"
        .Cells(3).range.Text = "Text"
        .Cells(4).range.Text = "Interview"
        .Cells(5).range.Text = "Date"
    End With

    'Get info from each comment from oDoc and insert in table
    For n = 1 To nCount
        With oTable.Rows(n + 1)
            'Page number
            .Cells(1).range.Text = _
                oDoc.Comments(n).Scope.Information(wdActiveEndPageNumber)
            'The comment itself
            .Cells(2).range.Text = oDoc.Comments(n).range.Text
            'The text marked by the comment
            .Cells(3).range.Text = oDoc.Comments(n).Scope
            'The comment author
            .Cells(4).range.Text = oDoc.Comments(n).Author
            'The comment date in format dd-MMM-yyyy
            .Cells(5).range.Text = Format(oDoc.Comments(n).Date, "dd-MMM-yyyy")
        End With
    Next n

    Application.ScreenUpdating = True
    Application.ScreenRefresh

    oNewDoc.Activate
    MsgBox nCount & " comments found. Finished creating comments document.", vbOKOnly, Title

ExitHere:
    Set oDoc = Nothing
    Set oNewDoc = Nothing
    Set oTable = Nothing
End Sub

1 Ответ

1 голос
/ 24 марта 2020

После: 

.Cells(3).Range.Text = oDoc.Comments(n).Scope

Вставка: 

    If oDoc.Comments(n).Scope.Information(wdWithInTable) = True Then
      If oDoc.Comments(n).Scope.Cells(1).ColumnIndex > 1 Then
        .Cells(3).Range.InsertBefore Split(oDoc.Comments(n).Scope.Rows(1).Cells(1).Range.Text, vbCr)(0) & vbTab
      End If
    End If
...