1

Тема: Вставка картинок с именами файлов.

Доброго времени суток всем.

Ломаю голову уже неделю, так и не могу решить проблему. В VB я туговат, но нужно решить задачу.

Дано: Папка с фотографиями. Пустой документ "Вставка фотографий". Часть кода.
Нужно сделать: Вставить фотографии в документ по 4 шт на лист 2х2 (это часть кода решает) и нужно чтобы под каждым фото было имя файла фото. Т.е. у меня фотки в папке уже переименованы как фото 001, фото 002 и тд. Нужно чтобы под каждой фотографией стояло название фото 001, соответствующее имени файла. (Вроде бы понятно написал)

Вот часть кода, которую нашел в и-нете

Sub m_1()
Dim oDocument As Word.Document
Dim Флаг As Boolean
Dim oTable As Word.Table
Dim FileSystemObject As Scripting.FileSystemObject
Dim Папка As Scripting.Folder
Dim Файл As Scripting.File
Dim ИмяПапки As String
Dim Вопрос As String
Dim НеизвестныеФайлы As String
Dim oCell As Word.Cell
Dim i As Long
'Проверка, что документ, в который будут вставляться фотографии, открыт.
    For Each oDocument In Documents
        If oDocument.Name = "Вставка фотографий.doc" Then
            Флаг = True
            Exit For
        End If
    Next oDocument
    If Флаг = False Then
        MsgBox "Документ, в который надо вставлять фотографии, не открыт", vbExclamation
        Exit Sub
    End If
'Просмотр папки с фотографиями. Если в этой папке окажутся форматы
'(последние буквы после точки в названии файла), не указанные в коде,
'то будет создан их список. Если в этом списке окажутся фотографии,
'то в код надо добавить форматы этих фотографий. Если изменения в код
'не будут внесены, то эти файлы из списка не будут добавлены в документ,
'даже если они будут фотографиями.
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберие папку с фотографиями"
        If .Show = 0 Then
            Exit Sub
        End If
        ИмяПапки = .SelectedItems(1)
    End With
    Вопрос = MsgBox("Была выбрана следующая папка" & vbCr & ИмяПапки, vbOKCancel + vbExclamation)
        If Вопрос = vbCancel Then
            Exit Sub
        End If
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set Папка = FileSystemObject.GetFolder(ИмяПапки)
    For Each Файл In Папка.Files
        If InStr(Файл.Type, "JPEG") = 0 And InStr(Файл.Type, "PNG") = 0 And _
            InStr(Файл.Type, "TIF") = 0 And InStr(Файл.Type, "GIF") = 0 And _
            InStr(Файл.Type, "Точечный рисунок") = 0 Then
            НеизвестныеФайлы = НеизвестныеФайлы & vbCr & Файл.Name
        End If
    Next Файл
    If НеизвестныеФайлы <> "" Then
        Вопрос = MsgBox("В папке с фотографиями находятся неизвестные коду форматы файлов." & vbCr & _
                "Просмотреть эти файлы? Среди них могут оказаться фотографии.", _
                vbCritical + vbYesNo)
        If Вопрос = vbYes Then
            Set oDocument = Documents.Add
            oDocument.Range = НеизвестныеФайлы
            Exit Sub
        End If
    End If
'Помещение в переменную oDocument документа, в который вставляем фотографии.
'В дальнейшем, в коде будем указывать не документ, а переменную oDocument,
'которая и будет из себя представлять этот документ.
    Set oDocument = Documents("Вставка фотографий.doc")
    oDocument.Sections(1).PageSetup.Orientation = wdOrientLandscape
'Создание образца таблицы и помещение её в автотекст.
    With oDocument
        Set oTable = .Tables.Add(.Range(Start:=.Range.End - 1, End:=.Range.End - 1), _
            NumRows:=2, NumColumns:=2, DefaultTableBehavior:=wdWord8TableBehavior, _
            AutoFitBehavior:=wdAutoFitWindow)
            With oTable
                .Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            End With
    End With
    NormalTemplate.AutoTextEntries.Add Name:="ТаблицаДляФотографий", Range:=oDocument.Tables(1).Range
'Добавление в документ новых таблиц и вставка в их ячейки фотографий.
    For Each Файл In Папка.Files
        If InStr(Файл.Type, "JPEG") > 0 Or InStr(Файл.Type, "PNG") > 0 Or _
            InStr(Файл.Type, "TIF") > 0 Or InStr(Файл.Type, "GIF") > 0 Or _
            InStr(Файл.Type, "Точечный рисунок") > 0 Then
            If i = 4 Then
                With oDocument
                    .Range(Start:=.Range.End - 1, End:=.Range.End - 1).InsertParagraph
                    NormalTemplate.AutoTextEntries("ТаблицаДляФотографий").Insert _
                        Where:=.Range(Start:=.Range.End - 1, End:=.Range.End - 1), RichText:=True
                End With
                i = 0
            End If
            i = i + 1
            oDocument.InlineShapes.AddPicture Файл.Path, SaveWithDocument:=True, _
                Range:=oDocument.Tables(oDocument.Tables.Count).Range.Cells(i).Range
        End If
    Next Файл
End Sub

Помогите пожалуйста. Начальник отдела для которого решается эта задача уже начинает психовать и орать, что для чего нужен такой спец, что не может решить проблему.

P.S. Извините если нарушил правила, я на форуме новичок и не очень разобрался с движком.

2

Re: Вставка картинок с именами файлов.

Ребята, что ни у кого нет идей как это можно воплотить? Помогите плиз!!!!