Страницы: 1
RSS
VBA. Изменить связь с внешней книгой.
 
Есть два Excel файла один «источник данных» другой «рабочий»  
В «рабочем» файле много формул с ссылками на определенные ячейки в «источнике данных».  
Структура у «источника данных»  не меняется, меняются значения в ячейках и название самого файла.  
Необходимо при открытии книги запросить у пользователя путь к новому «источнику данных»  
И заменить существующую связь на новую.  
З.Ы.  Связь в книге всего одна.
 
Связь в смысле - формула?  
Можно использовать св-во Formula объекта Range.    
 
Например вот так:  
Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"
 
, например, на листе формулы типа:  
=ЕСЛИ('C:\Documents and Settings\User\Desktop\calc\RRV\[Shop_List_2012_last.xls]Пакет '!$Q$16>0;"Считать";"")
Мне нужно макросом заменить во всех формулах заменить полное имя файла:  
'C:\Documents and Settings\User\Desktop\calc\RRV\[Shop_List_2012_last.xls]
на то каокое укажет пользователь, например:  
'C:\Documents and Settings\User\Desktop\[новый_прайс.xls]
 
в ексель есть:  
1. управление связями (до 2003 - правка - связи; в 2007/2010 - не знаю где, но тоже есть :)  
2. макрорекодер  
 
что это значит?    
делаем небольшой пример из двух файлов, записываем макрорекодером действия по ручному изменению связи, меняем записанный макрос.  
если что не получается - приходим на форум.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
спасибо всем кто хотел помочь )  
я пока решил эту задачку так:  
 
....  
 
exLink = Range("B1").Value '  в ячейке B1 указан полный путь к файлу.'старое имя связи  
 
MsgBox "Укажите файл - источник данных" _  
    & vbNewLine, vbInformation, "Путь к исходному файлу"  
 
   ' запрос пользователю на новый источник данных  
With Application.FileDialog(msoFileDialogFilePicker)  
.Show  
 strwPath = .SelectedItems(1) 'сохранение пути в переменную  
End With  
 
'замена ссвязей с старого источника данных на новый  
   ActiveWorkbook.ChangeLink Name:= _  
        exLink _  
       , NewName:= _  
       strwPath, _  
       Type:=xlExcelLinks  
 
 Range("B1").FormulaR1C1 = strwPath 'сохранение в ячейку B1 полного имени файла для следующего запуска  
....  
 
ЗЫ. возможно, кто-то знает спрособ попроще ))
 
Необходима похожая функция. Ситуация отличается тем, что:  
1. Источников данных несколько. Имена файлов отличаются 2 символами (цифры и буквы). Имена файлов-источников содержат наименование месяца (первые три буквы: "ЯНВ, ФЕВ, .., ИЮН, СЕН")  
2. Ежемесячно в отдельной папке создаются копированием из шаблона как источники так и "рабочий"-сводный файл. Путь к папке содержит год и месяц. Имена файлов-отчетов содержат наименование месяца аналогично файлам-источникам.  
3. Список файлов-источников предопределен. Может меняться в течении года при появлении новых объектов, но очень редко.  
 
Надо сделать чтобы при открытии отчета обновлялись ссылки на источники.  
 
Часть записанной макрорекордером функции:  
 
   ActiveWorkbook.ChangeLink _  
       Name:="\\СетеваяШара\2012\1202-ФЕВ_12\ОБЖ08_ФЕВ.xls", _  
       NewName:="\\СетеваяШара\2012\1203-МАР_12\ОБЖ08_МАР.xls", _  
       Type:=xlExcelLinks  
   ActiveWorkbook.ChangeLink _  
       Name:="\\СетеваяШара\2012\1202-ФЕВ_12\ОБЖ09_ФЕВ.xls", _  
       NewName:="\\СетеваяШара\2012\1203-МАР_12\ОБЖ09_МАР.xls", _  
       Type:=xlExcelLinks
 
Воспользовался помощью http://www.msoffice.nm.ru  
Результат:  
 
Sub ИзменениеСсылок()  
   With Application  
       .ScreenUpdating = False  
       .EnableEvents = False  
       iExcelLinks = ThisWorkbook.LinkSources(xlExcelLinks)  
       iPath = ActiveWorkbook.Path  
       ДлинаПути = Len(iPath)  
       Месяц = Mid(iPath, ДлинаПути - 5, 3)  
       If IsArray(iExcelLinks) = True Then  
           For Each iLink In iExcelLinks  
               iLinks = iLinks & vbCrLf & iLink  
               Оригинал = Mid(iLink, ДлинаПути + 2, 6)  
               ActiveWorkbook.ChangeLink Name:=iLink, _  
                   NewName:=iPath + "\" + Оригинал + Месяц + ".xls", _  
                   Type:=xlExcelLinks  
           Next  
       Else  
           MsgBox "Рабочая книга не содержит внешних ссылок"  
       End If  
       .EnableEvents = True  
       .ScreenUpdating = True  
   End With  
End Sub
Страницы: 1
Читают тему
Loading...