VBA: добавляем в документ Word рисунки из любой папки и формируем подписи к рисункам

Недавно коллеги попросили помочь им с оформлением отчёта, в котором должно было быть приложение из кучи рисунков.

Рисунков было много, они лежали в отдельной папке и названия файлов рисунков в документе должны были быть оформлены в виде подписей к этим рисункам. Дополнительно, подписи к рисункам должны были быть пронумерованы и оформлены в соответсвии с гостом.

Делать это вручную муторно и долго, поэтому я написал небольшой скрипт, который сделает всю эту работу за пару секунд.

Private Sub vstavka_ris()

Dim iDialog As FileDialog
Dim FileItem As Object, ComItem As Object, ExtFile$

  'Выбираем папку с рисунками
    Set ComItem = CreateObject("Scripting.FileSystemObject")
    Set iDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    If Not iDialog.Show Then Exit Sub

     'Добавляем рисунки из папки в документ
    For Each FileItem In ComItem.getfolder(iDialog.SelectedItems(1)).Files

      ExtFile = LCase(Mid(FileItem.Name, InStrRev(FileItem.Name, ".") + 1))
      
      If ExtFile = "jpg" Or ExtFile = "jpeg" Or ExtFile = "bmp" _
      Or ExtFile = "gif" Or ExtFile = "png" Or ExtFile = "TIFF" _
      Or ExtFile = "tif" Or ExtFile = "emf" Or ExtFile = "eps" Then
        
        ActiveDocument.Paragraphs.Add.Range.InlineShapes.AddPicture(FileItem.Path).Select

        With Selection
          .Style = "Рисунок"  'Присваиваем объекту рисунок стиль "Рисунок"
          .InsertAfter vbCr  'Переходим на новую строку и добавляем нумерованную подпись
          .InsertCaption Label:="Рисунок" 
             'Подпись рисука через тире (по госту) - название файла рисунка
          .InsertAfter ChrW(160) & "-" & ChrW(160) & ComItem.GetBaseName(FileItem.Name)
          .Next.Style = "Рисунок Название"  'Присваиваем подписи стиль "Рисунок Название"
        End With
          
      End If
    
    Next FileItem
    
End Sub

Перед запуском скрипта поместите курсор туда, куда вы собираетесь добавлять рисунки.

Я сознательно сформировал только 2 стиля для рисунков и для подписей к рисунку, т.к. удобнее потом отредактировать эти 2 стиля чтобы "причесать" разом все рисунки и все подписи к ним во всём документе.

Естественно, вставьте в скрипт те названия стилей для рисунков и подписей к ним, которые используются в вашем документе. Удачи!