Макрос на изменение источника связи между Word и Excel

[Василий.]

Добрый день программисты!

Описание ситуации
Есть документ Word (имя 1) и документ Excel (имя Первый). Я заполнил документ Excel и по ссылке открыл из Excel Word. Печатаю Word. Далее я сохраняю Excel под именем Второй с данными, чтоб можно было его, если нужно, открыть и еще раз распечатать Word, перейдя по ссылке из Excel.
Проблема
Если я открываю Word из файла Второй, то Word запрашивает обновление с Первого файла Excel, а надо со Второго. Как можно это исправить?

С уважением,
Василий.

[Василий.]

забыл вложить файл ...

[CyberMen]

Василий.
а вручную неудобно изменить связь?

[Василий.]

да я то могу, но есть люди которые могут только открыть лист ... поэтому так вот.

[Василий.]

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

Заранее спасибо.

[CyberMen]

Василий.
источник обновления запрашивается в Word.

[Василий.]

т.е. нельзя ничего сделать?

[Василий.]

Программисты Word!!!

Помогите с мокросом, позволяющий при открытии книги Word запросить пользователя об источнике обновления связей. Я не думая что это для Вас будет делом сложным и долгим, скорее для разогрева!

С уважением,
Василий.

[viter.alex]

Попробуй такой. Писал не для разогрева, а давным-давно.

Sub ChangeLinks()
  Dim oFld As Field 'Поле
  Dim OldFileName As String 'Старое имя файла
  Dim NewFileName As String 'Новое имя файла
  Dim FieldCode As String 'Код поля
  Dim ReplaceAllPath As Boolean 'Заменять весь путь к файлу или только имя
  Dim StartPath As Integer, EndPath As Integer 'Начало и конец пути к файлу в коде поля
  
  'Ввод старого имени файла
  OldFileName = InputBox("Укажите старое имя файла с расширением в ссылке, которое нужно изменить", "Изменение ссылок", OldFileName)
  If Len(OldFileName) = 0 Then Exit Sub
  
  'Выбор нового файла
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Выберите новый файл, с которым должен быть связан документ"
    .AllowMultiSelect = False
    .ButtonName = "Выбрать"
    .Filters.Clear
    .Filters.Add "Таблицы Excel", "*.xls; *.xlsx"
    If .Show Then NewFileName = .SelectedItems(1) Else Exit Sub
  End With
  
  'Если изменилось не только имя, но и местоположение, то можно заменить весь путь
  ReplaceAllPath = MsgBox("Заменять весь путь? Нажмите ""Нет"", чтобы заменить только имя файла", vbYesNo + vbInformation, "Изменение ссылок") = vbYes
  
  NewFileName = Replace(NewFileName, "\", "\\")
  'Перебираем все поля в документе
  For Each oFld In ActiveDocument.Fields
    If oFld.Type = wdFieldLink Then 'Если поле является полем ссылки
      FieldCode = oFld.Code.Text
      If InStr(oFld.Code.Text, "Excel.Sheet") <> 0 And InStr(FieldCode, "\\" & OldFileName) <> 0 Then 'Если поле ссылается на лист Excel и на нужный файл
        If ReplaceAllPath Then 'Если нужно заменить весь путь
          StartPath = InStr(FieldCode, ":\\") - 2
          EndPath = InStr(FieldCode, "\\" & OldFileName) + Len(OldFileName) + 2
          FieldCode = Mid(FieldCode, 1, StartPath) & NewFileName & Mid(FieldCode, EndPath)
        Else 'Если нужно заменить только имя файла
          FieldCode = Replace(FieldCode, OldFileName, Mid(NewFileName, InStrRev(NewFileName, "\") + 1))
        End If
      End If
    End If
    oFld.Code.Text = FieldCode
  Next
End Sub

[Василий.]

для viter.aleх

Сейчас попробую ... и всё-равно спасибо за уделённое время.