Изменение ссылок в формулах в книге с помощью VBA.

Пользователь

Сообщений: 47 Регистрация: 08.10.2017

06.12.2018 15:38:26

Добрый день.
Есть открытая книга, в которой в формулах есть ссылки на сторонний документ в сети, вроде такой ='\path\DATA\[wsName.xlsm]Discription'!$E$13
Есть вторая открытая книга, например 1.0.xlsm.
Я хочу заменить "\path\DATA\[wsName.xlsm]" на новый путь книги.
Пытался делать так:

Код

For Each wb In Application.Workbooks 
    If wb.name Like "1.0*" Then
        newAddress = wb.path & "\[" & wb.name & "]" 'Получаем ссылку
    End If
Next

Dim ttt As String
ttt = "\\path\DATA\[wsName.xlsm]"
With ThisWorkbook.Worksheets(1).UsedRange
    .Replace What:=ttt, _
    Replacement:=newAddress, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
End With

Но не работает. Ничего не происходит.
Пытался делать так, тоже не работает:

Код
ThisWorkbook.ChangeLink name:= _ "path\DATA\wsName.xlsm", NewName:=newAddress _ , Type:=xlExcelLinks

Причем, если вместо newAddress вписать путь открытой книги - все равно не работает. А если вместо newAddress вписать путь другой книги (которая не открыта), то все отработает нормально.
Поэтому предполагаю, что это связано с тем, что данная книга открыта.

Отсюда вопрос, как можно исправить ситуацию? Или может быть вы подскажете хороший способо обновить все ссылки в формулах в книге на новый путь (новый путь - путь второй открытой(!!!) книги).
Спасибо

Изменено: crjk - 06.12.2018 15:41:23

skais675

Пользователь

Сообщений: 2211 Регистрация: 03.06.2014

06.12.2018 20:27:16

Код

While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        
        Dim aL(), i&, s
        aL = importWB.LinkSources(xlExcelLinks)
        If IsEmpty(aL) Then Exit Sub
        For i = 1 To UBound(aL)
            s = Split(aL(i), "\")
            Application.StatusBar = FilesToOpen(x) + " - " + s(UBound(s))
            importWB.ChangeLink aL(i), importWB.Path & "\" & s(UBound(s)), 1
            importWB.UpdateLink Name:=importWB.Path & "\" & s(UBound(s)), Type:=xlExcelLinks
        Next
        importWB.RefreshAll
        importWB.Close savechanges:=True
        x = x + 1
    Wend

Мой канал

crjk Пользователь Сообщений: 47 Регистрация: 08.10.2017	#3 07.12.2018 09:56:09 skais675, Спасибо, буду пробовать

DenSyo

Пользователь

Сообщений: 82 Регистрация: 15.05.2018

07.12.2018 10:25:13

Цитата
crjk написал: Поэтому предполагаю, что это связано с тем, что данная книга открыта.

именно. сделайте проверку открыта книга или нет и если открыта не добавляйте путь в новой ссылке. добавьте функцию IsBookOpen из примеров по ссылке и замените часть кода

Код
For Each wb In Application.Workbooks If wb.Name Like "1.0*" Then newAddress = IIf(IsBookOpen(wb.Name), "", wb.Path & "\") & "[" & wb.Name & "]" End If Next

Изменено: DenSyo - 07.12.2018 14:59:42