Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
25.01.2021, 03:46:22

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
31 743 Сообщений в 5 102 Тем от 11 624 Пользователей
Последний пользователь: atoboqah
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Word и VBA
| | |-+  Связать файл ворд с таблицами эксель для обновления
Страниц: [1]   Вниз
Печать
Автор Тема: Связать файл ворд с таблицами эксель для обновления  (Прочитано 2203 раз)
0 Пользователей и 2 Гостей смотрят эту тему.
kentavrik
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля E-mail
« : 22.05.2018, 09:26:07 »

Здравствуйте стоит такая задача. Необходимо связать файл WORD с EXEL, с определенным файлом для подтягивания диаграмм. Но чтобы была возможность поменять файл EXEL и данные в WORDавтоматически подтянулись. Например есть файл "док 1" (в приложении) там есть диаграмма она автоматически связана с файлом "Книга 5". Нужно сделать так чтобы можно было автоматически подтянуть данные, например выбрал файл "Книгу 2", диаграмма в "Док 1" должна автоматически обновится. Помогите очень нужно
Также важно чтобы в диаграммах не менялся исходный формат диаграмм, то есть они не становились больше или меньше, уже или шире..
В интернете нашел вот такой:
Цитировать
Sub Смена_источника_данных()
'
' Смена_источника_данных Макрос
'
  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 'Начало и конец пути к файлу в коде поля
  Dim FullPath As String
  Dim Name As String
     
    For Each oFld In ActiveDocument.Fields
    If oFld.Type = wdFieldLink Then 'Если поле является полем ссылки
        If InStr(oFld.Code.Text, "Excel.SheetMacroEnabled.12") <> 0 Then 'Если поле ссылается на лист Excel
            FullPath = oFld.Code.Text
            Exit For
        End If
    End If
    Next
     
 'Отделение имени файла от мусора
  i = InStrRev(FullPath, "\\") 'позиция последнего \\
  Name = Mid(FullPath, i + 2)
  j = InStrRev(Name, Chr(34)) 'позиция конца имени файла с расширением
  OldFileName = Left(Name, j - 1)
   
  'Ввод старого имени файла
  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; *.xlsm"
    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.SheetMacroEnabled.12") <> 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
      oFld.Code.Text = FieldCode
    End If
  Next
End Sub
Записан
sboy
Постоялец
***

Репутация: +27/-0
Офлайн Офлайн

Сообщений: 207


Просмотр профиля E-mail
« Ответ #1 : 22.05.2018, 09:33:50 »

Кросс
Записан
kentavrik
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля E-mail
« Ответ #2 : 22.05.2018, 11:24:52 »

ВОТ С ЭТИМИ ФАЙЛАМИ необходимо производить переключение
Записан
kentavrik
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля E-mail
« Ответ #3 : 23.05.2018, 12:38:35 »

Вот так решалась моя проблема. Вставлять в ворд вба
Код: (vb)
Sub switchSource()
    ' Создадим объект словаря - будем сохранять все адреса источников
    Dim linksDic As Object
    Set linksDic = CreateObject("Scripting.Dictionary")
    
    'Выбор нового файла
    With Application.FileDialog(msoFileDialogFilePicker)
        ' Заголовок
        .Title = "Выберите новый файл, с которым должен быть связан документ"
        ' Разрешено открыть только 1 файл
        .AllowMultiSelect = False
        ' Название кнопки
        .ButtonName = "Выбрать"
        ' Показывать только Excel-файлы
        .Filters.Clear
        .Filters.Add "Таблицы Excel", "*.xls; *.xlsx"
        ' Если все ок - продолжим, если нет - выходим из макроса
        If .Show Then NewFileName = .SelectedItems(1) Else Exit Sub
    End With
    
    ' Работаем с текущим документом
    With ThisDocument
         ' Для каждого графика в документе...
        For Each shp In .InlineShapes
            ' Первый проход - считаем кол-во диаграмм, где используется источник
            If linksDic.Exists(shp.LinkFormat.SourceFullName) Then
                linksDic(shp.LinkFormat.SourceFullName) = linksDic(shp.LinkFormat.SourceFullName) + 1
            Else
                linksDic(shp.LinkFormat.SourceFullName) = 1
            End If
        Next shp
        
        ' Для каждого графика в документе...
        For Each shp In .InlineShapes
            ' Если источник уже встречался на предыдущем этапе (перестраховка)...
            If linksDic.Exists(shp.LinkFormat.SourceFullName) Then
                ' ... и если кол-во диаграмм его использующих > 1, то...
                ' ... задать источником - файл, выбранный ранее
                If linksDic(shp.LinkFormat.SourceFullName) > 1 Then shp.LinkFormat.SourceFullName = NewFileName
            End If
        Next shp
        '  Когда для каждого графика заданы источники - обновить все значения в документе
        .Fields.Update
    End With
    ' Вывести сообщение
    MsgBox "Готово.", vbInformation
End Sub

Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru