Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Массовый разрыв связей, с вызовом окна по выбору папки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Массовый разрыв связей, с вызовом окна по выбору папки (Макросы/Sub)
Массовый разрыв связей, с вызовом окна по выбору папки
Литраж Дата: Пятница, 11.04.2014, 10:24 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

MS Office 2007
Всем здравствуйте.

При выполнении макроса, (который по крупинкам собирался с различных форумов) выполняющего вызов окна на выбор папки, в которой во всех файлах разрываются связи с другими книгами. Макрос запускается из кнопки на ленте (Офис 2007). Когда-то все работало:(
А сейчас возникает ошибка: erorr 1004 method 'breaklink' of object '_Workbook' failed. Ругается на ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
Помогите, пожалуйста, разобраться по какой причине возникает ошибка и поделиться способами решения. Собственно сам код:

[vba]
Код
Sub Links(ByVal Control As IRibbonControl)

'открываем всё подряд
DisplayAlerts = False
Dim aFile As File, fso As New FileSystemObject, wkb As Workbook
ПутьКПапке = GetFolderPath("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя папки
      If ПутьКПапке = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки
For Each aFile In fso.getfolder(ПутьКПапке).Files
DisplayAlerts = False
If fso.GetExtensionName(aFile.Name) Like "xls*" Then
Set wkb = Workbooks.Open(aFile.Path)
'обрезаем связи

Dim iLinks As Variant, i&
iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(iLinks) Then
Set fso = New FileSystemObject
For i = 1 To UBound(iLinks)
ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
Next i
End If

'сохраняем и переходим к следующему

wkb.Close SaveChanges:=True
Set wkb = Nothing
End If
Next

'заканчиваем

End Sub
[/vba]

Функция на вызов окна, которую я использую (не моя), мало ли:

[vba]
Код
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                          Optional ByVal InitialPath As String = "W:\Журавлёва\") As String
       ' функция выводит диалоговое окно выбора папки с заголовком Title,
      ' начиная обзор диска с папки InitialPath
      ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
      Dim PS As String: PS = Application.PathSeparator
       With Application.FileDialog(msoFileDialogFolderPicker)
           If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
           .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
           If .Show <> -1 Then Exit Function
           GetFolderPath = .SelectedItems(1)
           If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
       End With
End Function
[/vba]

Также интересует, как убрать всплывающий запрос Excel на неудачную попытку обновления связей. UpdateLinks и DisplayAlerts не помогают. Помогите, пожалуйста, дилетанту.


Сообщение отредактировал Литраж - Пятница, 11.04.2014, 10:25
 
Ответить
СообщениеВсем здравствуйте.

При выполнении макроса, (который по крупинкам собирался с различных форумов) выполняющего вызов окна на выбор папки, в которой во всех файлах разрываются связи с другими книгами. Макрос запускается из кнопки на ленте (Офис 2007). Когда-то все работало:(
А сейчас возникает ошибка: erorr 1004 method 'breaklink' of object '_Workbook' failed. Ругается на ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
Помогите, пожалуйста, разобраться по какой причине возникает ошибка и поделиться способами решения. Собственно сам код:

[vba]
Код
Sub Links(ByVal Control As IRibbonControl)

'открываем всё подряд
DisplayAlerts = False
Dim aFile As File, fso As New FileSystemObject, wkb As Workbook
ПутьКПапке = GetFolderPath("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя папки
      If ПутьКПапке = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки
For Each aFile In fso.getfolder(ПутьКПапке).Files
DisplayAlerts = False
If fso.GetExtensionName(aFile.Name) Like "xls*" Then
Set wkb = Workbooks.Open(aFile.Path)
'обрезаем связи

Dim iLinks As Variant, i&
iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(iLinks) Then
Set fso = New FileSystemObject
For i = 1 To UBound(iLinks)
ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
Next i
End If

'сохраняем и переходим к следующему

wkb.Close SaveChanges:=True
Set wkb = Nothing
End If
Next

'заканчиваем

End Sub
[/vba]

Функция на вызов окна, которую я использую (не моя), мало ли:

[vba]
Код
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                          Optional ByVal InitialPath As String = "W:\Журавлёва\") As String
       ' функция выводит диалоговое окно выбора папки с заголовком Title,
      ' начиная обзор диска с папки InitialPath
      ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
      Dim PS As String: PS = Application.PathSeparator
       With Application.FileDialog(msoFileDialogFolderPicker)
           If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
           .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
           If .Show <> -1 Then Exit Function
           GetFolderPath = .SelectedItems(1)
           If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
       End With
End Function
[/vba]

Также интересует, как убрать всплывающий запрос Excel на неудачную попытку обновления связей. UpdateLinks и DisplayAlerts не помогают. Помогите, пожалуйста, дилетанту.

Автор - Литраж
Дата добавления - 11.04.2014 в 10:24
Литраж Дата: Среда, 16.04.2014, 03:45 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

MS Office 2007
Неужели мне никто не поможет? ?
 
Ответить
СообщениеНеужели мне никто не поможет? ?

Автор - Литраж
Дата добавления - 16.04.2014 в 03:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Массовый разрыв связей, с вызовом окна по выбору папки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!