Макрос для вставки перекрестной ссылки на основе выбора

В настоящее время я работаю в компании, которая использует установленный домашний стиль для своих документов. Это включает в себя многоуровневые пронумерованные заголовки, встроенные в наш шаблон Word. Т.е.

  1. Заголовок 1

1.1 Заголовок 2

1.1.1 Заголовок 3

так далее...

Большая часть нашей текущей задачи заключается в добавлении перекрестных ссылок на другие части документа. Это может занять довольно много времени, когда документ работает на нескольких сотнях страниц с примерно 10 ссылками на каждой странице.

Мне было интересно, можно ли настроить макрос для добавления x-ref на основе того, что выделено курсором. Т.е., если бы у вас было предложение, которое гласило "пожалуйста, обратитесь к пункту 3.2", вы могли бы выделить часть "3.2", запустить макрос и вставить x-ref, связанный с заголовком 3.2.

Не уверен, что это вообще возможно, но был бы благодарен за любой совет.

Источник

2 ответа

Решение

Этот код будет - условно - делать то, что вы хотите.

Sub InsertCrossRef()

    Dim RefList As Variant
    Dim LookUp As String
    Dim Ref As String
    Dim s As Integer, t As Integer
    Dim i As Integer

    On Error GoTo ErrExit
    With Selection.Range
        ' discard leading blank spaces
        Do While (Asc(.Text) = 32) And (.End > .Start)
            .MoveStart wdCharacter
        Loop
        ' discard trailing blank spaces, full stops and CRs
        Do While ((Asc(Right(.Text, 1)) = 46) Or _
                  (Asc(Right(.Text, 1)) = 32) Or _
                  (Asc(Right(.Text, 1)) = 11) Or _
                  (Asc(Right(.Text, 1)) = 13)) And _
                  (.End > .Start)
            .MoveEnd wdCharacter, -1
        Loop

ErrExit:
        If Len(.Text) = 0 Then
            MsgBox "Please select a reference.", _
                   vbExclamation, "Invalid selection"
            Exit Sub
        End If

        LookUp = .Text
    End With
    On Error GoTo 0

    With ActiveDocument
        ' Use WdRefTypeHeading to retrieve Headings
        RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
        For i = UBound(RefList) To 1 Step -1
            Ref = Trim(RefList(i))
            If InStr(1, Ref, LookUp, vbTextCompare) = 1 Then
                s = InStr(2, Ref, " ")
                t = InStr(2, Ref, Chr(9))
                If (s = 0) Or (t = 0) Then
                    s = IIf(s > 0, s, t)
                Else
                    s = IIf(s < t, s, t)
                End If
                If LookUp = Left(Ref, s - 1) Then Exit For
            End If
        Next i

        If i Then
            Selection.InsertCrossReference ReferenceType:="Numbered item", _
                                           ReferenceKind:=wdNumberFullContext, _
                                           ReferenceItem:=CStr(i), _
                                           InsertAsHyperlink:=True, _
                                           IncludePosition:=False, _
                                           SeparateNumbers:=False, _
                                           SeparatorString:=" "
        Else
            MsgBox "A cross reference to """ & LookUp & """ couldn't be set" & vbCr & _
                   "because a paragraph with that number couldn't" & vbCr & _
                   "be found in the document.", _
                   vbInformation, "Invalid cross reference"
        End If
    End With
End Sub

Вот условия:

  1. В документе есть "Нумерованные элементы" и "Заголовки". Вы просили заголовки. Я сделал Numbered Items, потому что у меня нет этого стиля на моем ПК. Однако на моем ПК "Заголовки" есть пронумерованные пункты. Если код не работает на ваших документах, обмен wdRefTypeNumberedItem за wdRefTypeHeading в отмеченной строке в коде.
  2. Я предполагал формат нумерации, такой как "1", "1.1", "1.1.1". Если у вас есть что-то другое, возможно, "1". "1.1.", "1.1.1.", Код необходимо будет настроить. Ключевым моментом является то, что код будет искать пробел или табуляцию после числа. Если за ним следует точка или закрывающая скобка или тире, это не сработает. Также, если вам случится выбрать "1.2". (с окончательной полной остановкой) в тексте код игнорирует полную остановку и ищет ссылку "1.2". Обратите внимание, что код нечувствителен к случайным ошибкам в выборе. Он удалит все начальные или конечные пробелы, а также случайно включенные возврат каретки или знаки абзаца - и точки остановки.

Код заменит выбранный вами текст своим (идентичным) текстом. Это может привести к изменению существующего форматирования. Фактически, вставленное поле ссылки берет текст от цели. Я не совсем понял, какой формат он применяет, цель или заменяемый. Я не занимался этой проблемой, если она одна.

Пожалуйста, взгляните на свойства перекрестной ссылки на вставки кода. Вы увидите, что InsertAsHyperlink правда. Вы можете установить его в False, если хотите. IncludePosition Неверно Если вы установите для этого свойства значение True, к номеру, который заменяет код, добавится "выше" или "ниже".

Источник

Да, это вполне возможно...

Но так как это не служба написания кода, я приведу вам (пример) ключевые элементы:

' Check if a reference exists
If instr(lcase(selection.Sentences(1).Text), "refer to clause") then

' Figure out the reference number...
(see here: https://stackru.com/questions/15369485/how-to-extract-groups-of-numbers-from-a-string-in-vba)

' Get a list of available references
refList = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

' Add the reference
selection.InsertCrossReference(wdRefTypeNumberedItem ,wdNumberFullContext, xxxxxx...

Возможно, посмотрите, как далеко вы можете получить, и отправьте ответ с более конкретными и целенаправленными вопросами:)

Источник
Другие вопросы по тегам