ddmitriy (Автор тем)

5941 Запрашиваемый номер семейства не существует

Пользователь

Сообщений: 5 Регистрация: 01.10.2014

21.06.2017 17:17:09

Добрый день.
При вставке фотографии в шаблон Word выскакивает ошибка "5941 Запрашиваемый номер семейства не существует"

Код

With WD
Picture_count = Picture_count + 1
    .Bookmarks("pic1").Range.Select
    FolderPic = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Pic1\")
    Dim coll As Collection
    If Dir(FolderPic, vbDirectory) = "" Then
        MsgBox "No Folder Pic1" & folder$ & "»", vbCritical, "No Folder "
        GoTo pict_1
    End If
    Set coll = FilenamesCollection(FolderPic, ".jpg")
    For i = 1 To coll.Count
          
       WA.Selection.InlineShapes.AddPicture Filename:=coll.Item(i)
       WA.Selection.TypeParagraph
    Next i
pict_1: End With

Ошибка указывает на строку.

Код
.Bookmarks("pic1").Range.Select

Закладки проверил, всё в норме. Подскажите что ещё может быть не так.

Спасибо.

Перейти

Доработка макроса вставки фотографий

ddmitriy

Пользователь

Сообщений: 5 Регистрация: 01.10.2014

13.01.2017 09:13:36

Добрый день.
Есть файл Excel который собирает документ Word вставляя туда все фотографии из папки Pic2.
Подскажите как изменить код что бы вставлялись не все фотографии, а только одна, имя которой прописано в ячейке F6.

Код

With WD
Picture_count = Picture_count + 1
    .Bookmarks("pic2").Range.Select
    FolderPic = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Pic2\")
    If Dir(FolderPic, vbDirectory) = "" Then
        MsgBox "No Folder Pic1" & folder$ & "»", vbCritical, "No Folder "
        GoTo pict_2
    End If
    Set coll = FilenamesCollection(FolderPic, ".jpg")
    For i = 1 To coll.Count
        
       WA.Selection.InlineShapes.AddPicture Filename:=coll.Item(i)
       WA.Selection.TypeParagraph
            WA.Selection.TypeText Text:="Рисунок" + LTrim(Str(Picture_count)) + " "
            WA.Selection.TypeParagraph
        'WA.Selection.InsertCaption Label:="Figure"
'        Selection.InsertCaption Label:="Pic "   ', TitleAutoText = "InsertCaption1" ', Title = "", Position = wdCaptionPositionBelow, ExcludeLabel = 0
    Next i
pict_2: End With

Спасибо.

Перейти