Excel это не сложно

Основные форумы => Вопросы по Word и VBA => Тема начата: kentavrik от 22.05.2018, 09:26:07



Название: Связать файл ворд с таблицами эксель для обновления
Отправлено: kentavrik от 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


Название: Re:Связать файл ворд с таблицами эксель для обновления
Отправлено: sboy от 22.05.2018, 09:33:50
Кросс (http://www.excelworld.ru/forum/10-38347-1#253284)


Название: Re:Связать файл ворд с таблицами эксель для обновления
Отправлено: kentavrik от 22.05.2018, 11:24:52
ВОТ С ЭТИМИ ФАЙЛАМИ необходимо производить переключение


Название: Re:Связать файл ворд с таблицами эксель для обновления
Отправлено: kentavrik от 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