Почему макрос вставки изображений в Word работает странно?

Question

[js-newbie]

Написал примитивный макрос для вставки изображений по ссылкам в документах Word. Т.е. у меня есть документы, содержащие текст, внутри которого встречаются ссылки на изображения с одного конкретного сайта. Нужно заменить ссылки на непосредственно сами изображения.

Sub Link2img()
    Dim TempData As DataObject
    Dim Count As Integer
    Dim ImgURL As String
    Dim ImgNum As String
    Count = 0
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "https://aaa.bbb.com/images/?*.[jpng]{3}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do While (.Execute = True)
            Selection.Find.Execute
            Selection.Copy
            Set TempData = New DataObject
            TempData.GetFromClipboard
            ImgURL = TempData.GetText
            Selection.Delete
            Selection.InlineShapes.AddPicture FileName:=ImgURL, LinkToFile:=False, SaveWithDocument:=True
            Count = Count + 1
        Loop
    End With
    If Count < 2 Then ImgNum = " изображение"
    If Count > 1 And Count < 5 Then ImgNum = " изображения"
    If Count > 4 Then ImgNum = " изображений"
    MsgBox ("Вставлено " & Count & ImgNum)
End Sub

В других версиях не пробовал, но в Word 2007 макрос вставляет только каждое второе, т.е. чётное изображение плюс самое последнее, независимо от его чётности/нечётности и от общего количества изображений. Помогите, пожалуйста, найти ошибку?

Answer 1

[js-newbie]

Разобрался сам. Строка Selection.Find.Execute в цикле Do While (.Execute = True) ... Loop была лишней. Она и заставляла при нахождении ссылки сразу искать следующую и только потом выполнять действия.

В итоге макрос должен быть таким:

Sub Link2img()
    Dim TempData As DataObject, Count As Integer, ImgURL, ImgNum As String
    Count = 0
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "https://aaa.bbb.com/images/?*.[jpng]{3}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do While (.Execute = True)
            Selection.Copy
            Set TempData = New DataObject
            TempData.GetFromClipboard
            ImgURL = TempData.GetText
            Selection.Delete
            Selection.InlineShapes.AddPicture FileName:=ImgURL, LinkToFile:=False, SaveWithDocument:=True
            Count = Count + 1
        Loop
    End With
    If Count < 2 Then ImgNum = " изображение"
    If Count > 1 And Count < 5 Then ImgNum = " изображения"
    If Count > 4 Then ImgNum = " изображений"
    MsgBox ("Вставлено " & Count & ImgNum)
End Sub

Comments

[h8nor]

Замечательно :)

Answer 2

[Dimonchik]

возьми десяток картинок и сравни варианты

или сюда