Выбор данных, выгружаемых из Excel в Word в зависимости от выбранного периода

fieldCount = ActiveDocument.Fields.Count
For x = 1 To fieldCount
If ActiveDocument.Fields(x).LinkFormat.SourceName Like "*ÁÄÐ*" Then
ActiveDocument.Fields(x).LinkFormat.SourceFullName = newFile1
ElseIf ActiveDocument.Fields(x).LinkFormat.SourceName Like "*ÁÄÄÑ*" Then
ActiveDocument.Fields(x).LinkFormat.SourceFullName = newFile2

Sub Процедура1()
    Dim i As Long
    For i = 1 To ActiveDocument.Fields.Count Step 1
        If ActiveDocument.Fields(i).Type = wdFieldLink Then
            If ActiveDocument.Fields(i).LinkFormat.SourceName Like "*Word*" Then
                Debug.Print "Match"
            End If
        End If
    Next i
End Sub

For i = 1 To ActiveDocument.Fields.Count Step 1
If ActiveDocument.Fields(i).Type = wdFieldLink Then
            If ActiveDocument.Fields(i).LinkFormat.SourceName Like "*ÁÄÐ*" Then
ActiveDocument.Fields(i).LinkFormat.SourceFullName = newFile1
            ElseIf ActiveDocument.Fields(i).LinkFormat.SourceName Like "*ÁÄÄÑ*" Then
ActiveDocument.Fields(i).LinkFormat.SourceFullName = newFile2
 
End If
End If
Next i

Sub Процедура1()
    Const strClass As String = "LINK Excel.Sheet.8 "
    Const strNewPath As String = _
        "C:\\Documents and Settings\\Пользователь\\Рабочий стол\\Для связи с Word 2.xls"
    Const strSheet As String = "Лист1!R1C1"
    Const strParameters As String = " \a \t \* MERGEFORMAT"
    'Chr(34) - это кавычка, Chr(32) - это пробел.
    ActiveDocument.Fields(1).Code.Text = strClass & Chr(34) & _
        strNewPath & Chr(34) & Chr(32) & Chr(34) & strSheet & Chr(34) & strParameters
    ActiveDocument.Fields(1).Update
End Sub

Sub Изменить_источник()
'макрос, который позволяет обновить все связи с документом путём выбора новых связанных документов
 
 
Dim dlgSelectFile As FileDialog 'FileDialog object
Dim thisField As Field
Dim selectedFile As Variant 'must be Variant to contain filepath of selected item
Dim newFile1 As Variant, newFile2 As Variant
Dim fieldCount As Integer
Dim i As Long
 
 
 
 Dim Msg1, Style, Title1, Response1
Msg1 = "Выберите последний актуальный проверенный БДР для обновления таблиц в документе"
Style = vbOKCancel   ' Определяет кнопки
Title1 = "Выбор БДР"    ' Заголовок диалогового окна
 
        ' Display message.
Response1 = MsgBox(Msg1, Style, Title1)
If Response1 = vbOK Then    ' Если пользователь выбрал "Да"
 
  
'Диалоговое окно выбора файла
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  
With dlgSelectFile
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
newFile1 = selectedFile 'получение нового пути расположения документа
Next selectedFile
Else: MsgBox "Вы не выбрали документ для обновления связи", vbOKOnly, "Ошибка"
End 'Если пользователь нажмёт "Отмена"
End If
End With
Set dlgSelectFile = Nothing
 
    
Else: End  ' Если пользователь нажал в первом сообщении кноку "Отмена"
 
End If
 
 
 Dim Msg2, Title2, Response2
Msg2 = "Выберите последний актуальный проверенный БДДС для обновления таблиц в документе"
Title2 = "Выбор БДДС"    ' Заголовок диалогового окна
 
        ' Display message.
Response2 = MsgBox(Msg2, Style, Title2)
If Response2 = vbOK Then    ' Если пользователь выбрал "Да"
 
  
'Диалоговое окно выбора файла
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  
With dlgSelectFile
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
newFile2 = selectedFile 'получение нового пути расположения документа
Next selectedFile
Else: MsgBox "Вы не выбрали документ для обновления связи", vbOKOnly, "Ошибка"
End 'Если пользователь нажмёт "Отмена"
End If
End With
Set dlgSelectFile = Nothing
 
    
Else: End  ' Если пользователь нажал в первом сообщении кноку "Отмена"
 
End If
 
 
 
 
 
For i = 1 To ActiveDocument.Fields.Count Step 1
If ActiveDocument.Fields(i).Type = wdFieldLink Then
            If ActiveDocument.Fields(i).LinkFormat.SourceName Like "*БДР*" Then
ActiveDocument.Fields(i).LinkFormat.SourceFullName = newFile1
            ElseIf ActiveDocument.Fields(i).LinkFormat.SourceName Like "*БДДС*" Then
ActiveDocument.Fields(i).LinkFormat.SourceFullName = newFile2
 
End If
End If
Next i
 
 For Each oTable In ActiveDocument.Tables
   'oTable.Rows.WrapAroundText = False
        oTable.Rows.Alignment = wdAlignRowCenter
     '   oTable.Range.Style = ActiveDocument.Styles(wdStyleNormal)
   '     oTable.AutoFitBehavior (wdAutoFitWindow)
   '     oTable.Rows.HeightRule = wdRowHeightAuto 'Убирает галочку "Высота строки"
   Next
 
 
 
 
End Sub

Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
   
With dlgSelectFile
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
 
 
 
Const newFile1 As String = selectedFile 'ïîëó÷åíèå íîâîãî ïóòè ðàñïîëîæåíèÿ äîêóìåíòà
 
 
 
Next selectedFile
Else: MsgBox "Âû íå âûáðàëè äîêóìåíò äëÿ îáíîâëåíèÿ ñâÿçè", vbOKOnly, "Îøèáêà"
End 'Åñëè ïîëüçîâàòåëü íàæì¸ò "Îòìåíà"
End If
End With
Set dlgSelectFile = Nothing