Обновление сводных таблиц в разных файлах макросом

Дата: Пятница, 20.02.2015, 15:06 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день!

Имеется такая задачка: есть 4 файла, в которых имеется по одной сводной таблице, данные в которую подгружаются из внешней БД. Есть мысль создать отдельный файл, который поочередно открывал эти 4 файла, обновлял их и закрывал с сохранением.

Бьюсь второй день, все никак.
Решил сделать так: в каждый из 4 файлов зашит макрос:
[vba]

Код

Sub RefreshAll()
ActiveWorkbook.RefreshAll
End Sub

[/vba]

В главном файле следующий макрос:
[vba]

Код

Sub UpdateCollection()
BookName = ActiveWorkbook.Name
File1Path = Worksheets("Update").Range("B5").Value
File1Name = Worksheets("Update").Range("B6").Value
File2Path = Worksheets("Update").Range("B9").Value
File2Name = Worksheets("Update").Range("B10").Value
File3Path = Worksheets("Update").Range("B13").Value
File3Name = Worksheets("Update").Range("B14").Value
File4Path = Worksheets("Update").Range("B17").Value
File4Name = Worksheets("Update").Range("B18").Value
Pass = Worksheets("Update").Range("B2").Value
File1 = File1Path & "\" & File1Name
File2 = File2Path & "\" & File2Name
File3 = File3Path & "\" & File3Name
File4 = File4Path & "\" & File4Name
Workbooks.Open Filename:=File1, WriteResPassword:=Pass
Application.DisplayAlerts = False
Application.Run "'" & File1Name & "'!RefreshAll"
ActiveWorkbook.Save
ActiveWindow.Close False
Application.DisplayAlerts = True
Windows(BookName).Activate
MsgBox ("Finish")
End Sub

[/vba]

При этом файлы открываются, но обновления не происходит

А если открывать файлы отдельно - с помощью ActiveWorkbook.RefreshAll все прекрасно обновляется.

Подскажите, пожалуйста, может я что-то делаю не так?

Код

Sub RefreshAll()
ActiveWorkbook.RefreshAll
End Sub

[/vba]

В главном файле следующий макрос:
[vba]

Код

[/vba]

При этом файлы открываются, но обновления не происходит

А если открывать файлы отдельно - с помощью ActiveWorkbook.RefreshAll все прекрасно обновляется.

Подскажите, пожалуйста, может я что-то делаю не так?akyakovlev

СообщениеДобрый день!

Имеется такая задачка: есть 4 файла, в которых имеется по одной сводной таблице, данные в которую подгружаются из внешней БД. Есть мысль создать отдельный файл, который поочередно открывал эти 4 файла, обновлял их и закрывал с сохранением.

Бьюсь второй день, все никак.
Решил сделать так: в каждый из 4 файлов зашит макрос:
[vba]

Код

Sub RefreshAll()
ActiveWorkbook.RefreshAll
End Sub

[/vba]

В главном файле следующий макрос:
[vba]

Код

[/vba]

При этом файлы открываются, но обновления не происходит

Автор - akyakovlev
Дата добавления - 20.02.2015 в 15:06

Дата: Пятница, 20.02.2015, 15:19 | Сообщение № 2

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

akyakovlev, здравствуйте.

Если вы открываете книгу - она у Вас сразу становится активной. Не будет ли лишним делать ActiveWorkbook.RefreshAll через Application.Run?

По логике Вашей текущей программы Вы пытаетесь обновить только 1 книгу. Было бы логичнее скормить все четыре файла одному циклу, который бы брал нужные имена и пути перебором строк Вашего главного файла.

На уровне рекоммендаций: Option Explicit и всегда инициализация переменных Dim'ами.

Вопрос - что должно измениться в сводных таблицах при обновлении? Дата по привязке к сегодняшнему дню?

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Дата: Пятница, 20.02.2015, 15:39 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Rioran,

Цитата Rioran, 20.02.2015 в 15:19, в сообщении № 2

Не будет ли лишним делать ActiveWorkbook.RefreshAll через Application.Run?

Пока ничего умнее я не придумал))

Цитата Rioran, 20.02.2015 в 15:19, в сообщении № 2

По логике Вашей текущей программы Вы пытаетесь обновить только 1 книгу.

Так и будет, только не цикл, а просто продублируется аналогичный код для остальных трех файлов, обрезал для удобства

Цитата Rioran, 20.02.2015 в 15:19, в сообщении № 2

что должно измениться в сводных таблицах при обновлении? Дата по привязке к сегодняшнему дню?

Данные сводной таблицы должны обновиться из внешнего источника (обновление данных ежедневное)

Дата: Пятница, 20.02.2015, 15:55 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Если это как-то поможет: при включенных алертах в процессе "обновления" возникает ошибка "Это действие приведет к отмене команды обновелния данных. Продолжить?" и Варианты ОК, ОТМЕНА

Дата: Пятница, 20.02.2015, 16:04 | Сообщение № 5

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

akyakovlev, посмотрите, рефакторинг Вашего кода, общая логика сохранена, но обращение к активной книге без посредников:

[vba]

Код

Option Explicit

Sub UpdateCollection()

Dim FilePath As String
Dim FileName As String
Dim File As String
Dim Pass As String
Dim i As Long

With ThisWorkbook.Worksheets("Update")
Pass = .Range("B2").Value

For i = 5 To 17 Step 4
     FilePath = .Range("B" & i).Value
     FileName = .Range("B" & i + 1).Value
     File = FilePath & "\" & FileName
     Workbooks.Open FileName:=File, WriteResPassword:=Pass
     Application.DisplayAlerts = False
     ActiveWorkbook.RefreshAll
     ActiveWorkbook.Save
     ActiveWindow.Close
     Application.DisplayAlerts = True
Next i

Windows(ThisWorkbook.Name).Activate
MsgBox ("Finish")

End With

End Sub

[/vba]

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Дата: Пятница, 20.02.2015, 16:19 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Rioran, согласен, Ваш код более правильный, но тем не менее так тоже не обновляется

Цитата Rioran, 20.02.2015 в 16:04, в сообщении № 5

    Workbooks.Open FileName:=File, WriteResPassword:=Pass
    Application.DisplayAlerts = False
    ActiveWorkbook.RefreshAll
    ActiveWorkbook.Save

Подобную конструкцию я уже пробовал

Дата: Пятница, 20.02.2015, 16:52 | Сообщение № 7

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

akyakovlev, предположу, что мы закрываем книгу до того, как отработает обновление. Давайте уберём алерты и вставим DoEvents после рефреша:

[vba]

Код

Option Explicit

Sub UpdateCollection()

Dim FilePath As String
Dim FileName As String
Dim File As String
Dim Pass As String
Dim i As Long

With ThisWorkbook.Worksheets("Update")
Pass = .Range("B2").Value

For i = 5 To 17 Step 4
      FilePath = .Range("B" & i).Value
      FileName = .Range("B" & i + 1).Value
      File = FilePath & "\" & FileName
      Workbooks.Open FileName:=File, WriteResPassword:=Pass
      ActiveWorkbook.RefreshAll
      DoEvents
      ActiveWorkbook.Save
      ActiveWindow.Close
Next i

Windows(ThisWorkbook.Name).Activate
MsgBox "Finish"

End With

End Sub

[/vba]

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Сообщение отредактировал Rioran - Пятница, 20.02.2015, 16:52

Дата: Пятница, 20.02.2015, 16:56 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Rioran,

Цитата Rioran, 20.02.2015 в 16:52, в сообщении № 7

уберём алерты и вставим DoEvents после рефреша:

Идет процесс подключения к источнику данных (как, впрочем, и раньше), затем возникает ошибка "Это действие приведет к отмене команды обновелния данных. Продолжить?" и Варианты ОК, ОТМЕНА
После нажатия ОК файл закрывается без обновления

Дата: Пятница, 20.02.2015, 17:09 | Сообщение № 9

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

Не имея на руках файлы - продолжаю играть в Настрадамуса =)

Нашёл идею The_Prist'а по обновлению таблиц:

[vba]

Код

Sub Refresh_PVTables()

Dim wsSh As Worksheet
Dim PVTable As PivotTable

For Each wsSh In Worksheets
      For Each PVTable In wsSh.PivotTables
          PVTable.RefreshTable
      Next PVTable
Next wsSh

End Sub

[/vba]
Давайте попробуем совместить эту идею с нашей программой:

[vba]

Код

Option Explicit

Sub UpdateCollection()

Dim FilePath As String
Dim FileName As String
Dim File As String
Dim Pass As String
Dim i As Long

Dim wsSh As Worksheet
Dim PVTable As PivotTable

With ThisWorkbook.Worksheets("Update")
Pass = .Range("B2").Value

For i = 5 To 17 Step 4
      FilePath = .Range("B" & i).Value
      FileName = .Range("B" & i + 1).Value
      File = FilePath & "\" & FileName
      Workbooks.Open FileName:=File, WriteResPassword:=Pass

      For Each wsSh In ActiveWorkbook.Worksheets
          For Each PVTable In wsSh.PivotTables
              PVTable.RefreshTable
          Next PVTable
      Next wsSh

      ActiveWorkbook.Save
      ActiveWindow.Close
Next i

Windows(ThisWorkbook.Name).Activate
MsgBox ("Finish")

End With

End Sub

[/vba]

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Сообщение отредактировал Rioran - Пятница, 20.02.2015, 17:10

Дата: Пятница, 20.02.2015, 17:13 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Rioran,
Ура, заработало!
Последнее решение от Вас не пробовал, просто отключил в настройках подключений (в каждом из файлов) Фоновое обновление и все заработало))

Файлы выложить не мог - коммерческая тайна...

Спасибо за помощь!!!))

Дата: Пятница, 20.02.2015, 17:16 | Сообщение № 11

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

Цитата akyakovlev, 20.02.2015 в 17:13, в сообщении № 10

отключил в настройках подключений (в каждом из файлов) Фоновое обновление

akyakovlev, все, пора снимать про меня фильм "Унесённые пятницей" =) Должен был догадаться об этом ещё при размышлениях о DoEvents.

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279