Option Explicit
Option Base 1

Dim wrd, WDdoc As Object

Private Sub Main()
Dim DataSheet As Worksheet
Dim LastRow As Long, LastCol As Long
Dim i As Long, j As Long
Dim SaveName As String, IMPath As String

If Dir(ThisWorkbook.Path & "\шаблон.dotx") = "" Then
    MsgBox ("Не найден шаблон! Файлы не сформированы!")
    Exit Sub
End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set DataSheet = ThisWorkbook.Worksheets("данные")

LastRow = DataSheet.Cells(Rows.Count, 2).End(xlUp).Row
LastCol = DataSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Set wrd = CreateObject("Word.Application")
For i = 3 To LastRow Step 1
    Set WDdoc = wrd.Documents.Add(ThisWorkbook.Path & "\шаблон.dotx")
    'wrd.Visible = True
    
    For j = 2 To LastCol Step 1
        If Len(CStr(DataSheet.Cells(2, j).Value)) = 0 Then
            If Left(LCase(CStr(DataSheet.Cells(i, j).Value)), 4) = "http" Then
                Call replace_txt_HL(DataSheet.Cells(1, j).Value, DataSheet.Cells(i, j).Value)
            Else
                Call replace_txt(DataSheet.Cells(1, j).Value, DataSheet.Cells(i, j).Value)
            End If
        Else
            IMPath = DataSheet.Cells(2, j).Value & "\" & DataSheet.Cells(i, j).Value
            Call replace_txt_IM(DataSheet.Cells(1, j).Value, IMPath)
        End If
    Next j
    'wrd.Visible = True
    SaveName = ThisWorkbook.Path & "\result\" & DataSheet.Cells(i, 2).Value & DataSheet.Cells(i, 3).Value
    WDdoc.ExportAsFixedFormat OutputFileName:=SaveName & ".pdf", ExportFormat:=17
    WDdoc.Close False
    Set WDdoc = Nothing
Next i
wrd.Quit
Set wrd = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox ("Файлы сформированы!")
End Sub

Public Sub replace_txt(FNDtxt As String, NEWtxt As String, Optional v = 0) 'замена на текст
With wrd.Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FNDtxt
    .Replacement.Text = NEWtxt
    .Forward = True
    .Wrap = 1
    .MatchWholeWord = True
    .Execute Replace:=2
End With
End Sub

Public Sub replace_txt_HL(FNDtxt As String, NEWtxt As String, Optional v = 0) 'замена на ссылку
With wrd.Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FNDtxt
    .Forward = True
    .Wrap = 1
    .MatchWholeWord = True
End With
Do While wrd.Selection.Find.Execute = True
    WDdoc.Hyperlinks.Add Anchor:=wrd.Selection.Range, Address:=NEWtxt, TextToDisplay:=NEWtxt
Loop
End Sub

Public Sub replace_txt_IM(FNDtxt As String, IMPath As String, Optional v = 0) 'замена на картинку
Dim PIC As Object

If Dir(IMPath) = "" Then Exit Sub
With wrd.Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FNDtxt
    .Forward = True
    .Wrap = 1
    .MatchWholeWord = True
End With
Do While wrd.Selection.Find.Execute = True
    'wrd.Selection.EndKey Unit:=5
    'wrd.Selection.TypeParagraph
    'MsgBox (wrd.Selection.End)
    'WDdoc.Range(wrd.Selection.Start, wrd.Selection.End).Delete
    wrd.Selection.InlineShapes.AddPicture Filename:=IMPath, LinkToFile:=False, SaveWithDocument:=True
    wrd.Selection.TypeParagraph
    WDdoc.Content.InlineShapes(WDdoc.Content.InlineShapes.Count).ConvertToShape
    WDdoc.Shapes(WDdoc.Shapes.Count).WrapFormat.Type = 4
    WDdoc.Shapes(WDdoc.Shapes.Count).WrapFormat.AllowOverlap = False
Loop

'Selection.InlineShapes.AddPicture FileName:="C:\Users\NoName\Desktop\excel-word\111.jpg", LinkToFile:=False, SaveWithDocument:=True
End Sub

Sub ButtonUpload(control As IRibbonControl)
Call Main
End Sub