1 Тема от Gowdin

  • Gowdin
  • рядовой
  • Неактивен
  • Зарегистрирован: 24.12.2011
  • Сообщений: 3

Тема: Нужно создать таблицу из большого количества фотографий (около 1000).

Задача следующая. Есть большое количество фото, порядка 1000, которые нужно вставить в таблицу, чтобы каждое фото встало в свою ячейку. В MS Word приходится вставлять поштучно, что очень долго. Можно автоматизировать процесс? Типа, выделил все файлы фотографий, вставил в документ и они распределились по ячейкам таблицы, одно фото - одна ячейка. Либо, может есть какой сторонний софт, который может создать таблицу из фотографий, которую потом вставить в Word?
В идеале, конечно, силами самого Word (2016), т.к., таблица уже создана и отформатирована.

2 Ответ от Fck_This

  • Нужно создать таблицу из большого количества фотографий (около 1000).
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

Re: Нужно создать таблицу из большого количества фотографий (около 1000).

Gowdin пишет:

Задача следующая. Есть большое количество фото, порядка 1000, которые нужно вставить в таблицу, чтобы каждое фото встало в свою ячейку. В MS Word приходится вставлять поштучно, что очень долго. Можно автоматизировать процесс? Типа, выделил все файлы фотографий, вставил в документ и они распределились по ячейкам таблицы, одно фото - одна ячейка. Либо, может есть какой сторонний софт, который может создать таблицу из фотографий, которую потом вставить в Word?
В идеале, конечно, силами самого Word (2016), т.к., таблица уже создана и отформатирована.

Можно макросом. Вот кому-то надо было уже на форуме для вставки рисунков в документ. Только вам надо будет переделать под вставку в таблицу. Нужно будет перемещать курсор для вставки, указывая нужную ячейку.

Sub GetAllPicsFromFolder()
Dim oFSO, oFolder As Object
Dim oDoc As Document
Dim sFolder, sName, sPathName As String
Dim iHeight, iWidth, iCounter As Integer
    Set oDoc = ActiveDocument
    iCounter = 0
    sFolder = "C:\Users\client606_15\Desktop\Pictures" 'Путь к папке
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(sFolder) Then
        Set oFolder = oFSO.GetFolder(sFolder)
        For Each oFile In oFolder.Files
        sName = oFile.Name
            'Можно указать свой формат рисунка
            If InStr(sName, ".jpg") >= 1 Or InStr(sName, ".png") >= 1 Then
                sPathName = sFolder & "\" & sName
                iHeight = Selection.PageSetup.PageHeight
                iWidth = Selection.PageSetup.PageWidth
                Application.Selection.Range.InlineShapes.AddPicture sPathName, LinkToFile:=False, SaveWithDocument:=True
                iCounter = iCounter + 1
                oDoc.InlineShapes(iCounter).Height = iHeight
                oDoc.InlineShapes(iCounter).Width = iWidth
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
            End If
        Next oFile
    End If
    MsgBox "Все файлы внесены"
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871