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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

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

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

Цитата:

Цитата Gowdin

В MS Word приходится вставлять поштучно, что очень долго. »

А макросы на что?

Цитата:

Цитата Gowdin

В идеале, конечно, силами самого Word (2016), т.к., таблица уже создана и отформатирована. »

Тогда прилагайте в архиве Ваш документ и образцы фотографий (если сюда не поместится, то на RGhost или Яндекс.Диск). Укажите, что делать, если количество выбранных фотографий окажется больше числа ячеек таблицы.

Вот: https://yadi.sk/d/lKWxMkAD3MXKYg
дефектовка_пример - то, как оно должно выглядеть.
По-простому, через "запись макроса" что-то не разобрался, как перемещаться по списку файлов.

Gowdin, так, ну, кода-то там всего ничего будет. Примерная болванка:

Код:

    If objFSO.FolderExists(strFolder) Then

        With ActiveDocument.Tables.Item(1)

            For Each objFile In objFSO.GetFolder(strFolder).Files

                .Rows.Add

                .Cell(.Rows.Count, 1).Range.Text = .Rows.Count - 2

                .Cell(.Rows.Count, 2).Range.InlineShapes.AddPicture FileName:=objFSO.BuildPath(strFolder, objFile.Name), LinkToFile:=False, SaveWithDocument:=True

            Next

        End With

    End If

Основной вопрос — как лучше и удобнее будет организовать исполнение?! То есть, как сделать, например, выбор: выбор каталога с файлами, выбор файлов из одного каталога, выбор файлов с любого места? Как быть с документом: заполнять уже открытый существующий документ, делать на основе шаблона, создавать программно? В общем, опишите, как Вы сие видите.

Сие я вижу так.
У меня уже есть таблица в документе.
Я устанавливаю курсор на начальную ячейку, с которой буду заполнять столбец вниз.
Открываю диалог "вставить рисунок".
Выбираю нужное мне количество файлов.
Жму "вставить".
И они вставляются с начальной ячейки вниз.
Но не так, как делает Word по умолчанию, когда все рисунки вставляются в одну ячейку, а с распределением по строкам: одна ячейка - одно фото.
Если строк не хватает, они добавляются.

Не нравится мне этот сценарий. Предлагаю другой.

Вот код:

Скрытый текст

Код:

Option Explicit



Sub Sample()

    Dim objFileDialog As FileDialog

    Dim collSelectedFiles As FileDialogSelectedItems

    Dim strFileName As Variant

    

    Dim intCurrColumn As Integer

    

    

    If Application.Selection.Information(wdWithInTable) Then

        Set objFileDialog = Application.FileDialog(FileDialogType:=msoFileDialogOpen)

        

        With objFileDialog

            .Title = "Выберете изображения для размещения в таблице"

            .ButtonName = "Вставить"

            

            .Filters.Clear

            .Filters.Add "Изображения", "*.jpg; *.jpeg; *.png; *.gif; *.tif; *.tiff; *.bmp"

            .Filters.Add "Все файлы", "*.*"

            

            .AllowMultiSelect = True

            

            '.InitialView = msoFileDialogViewThumbnail

            

            If .Show() Then

                Set collSelectedFiles = .SelectedItems

                

                With Application.Selection.Tables.Item(1)

                    intCurrColumn = Application.Selection.Information(wdStartOfRangeColumnNumber)

                    

                    For Each strFileName In collSelectedFiles

                        .Rows.Add

                        

                        .Cell(.Rows.Count, 1).Range.Text = .Rows.Count - 2

                        .Cell(.Rows.Count, intCurrColumn).Range.InlineShapes.AddPicture FileName:=strFileName, LinkToFile:=False, SaveWithDocument:=True

                    Next

                End With

                

                Set collSelectedFiles = Nothing

            End If

        End With

        

        Set objFileDialog = Nothing

    Else

        MsgBox "Поместите курсор ввода внутрь ячейки таблицы", vbExclamation + vbOKOnly, "Курсор ввода находится вовне таблицы"

    End If

End Sub

Вот Ваша таблица:

Скрытый текст

Помещаете курсор ввода в одну из отмеченных ячеек и любым способом вызываете процедуру (горячая клавиша, строка меню, кнопка на панели инструментов — если таковое возможно в Вашей версии Word, або даже «ручками» из редактора VBA).
Выбираете изображения для вставки:

Скрытый текст

Получаете примерный результат:

Скрытый текст

В искомый столбец вставляются изображения, в первый столбец — номера по порядку. Никаких пустых строк предварительно добавлять не нужно.