Макрос MS Office: замена картинок именами файлов

Этот код заменяет все изображения (картинки, диаграммы, смарты) именами файлов:

Sub Picture_del()

Dim oInlineShape As InlineShape

Dim i As Integer

i = 1

Selection.HomeKey Unit:=wdStory

For Each oInlineShape In ActiveDocument.InlineShapes

oInlineShape.Select

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.TypeText Text:="[img]img" & i & ".tif[/img]"

i = i + 1

Next

End Sub

Этот код заменяет только картинки именами файлов

Sub del_pick()

  Dim ii, rng, nn

  nn = 0 'число собс-но картинок

  With ActiveDocument.InlineShapes

   For ii = 1 To .Count Step 1  'сначала считаем картинки

      If .Item(ii).Type = 3 Then 'Это картинка

        nn = nn + 1 'Увеличим счетчик картинок

      End If

   Next ii

   If nn > 0 Then ' Если есть что заменять

     For ii = .Count To 1 Step -1 'теперь пойдём от хвоста

       If .Item(ii).Type = 3 Then 'Это картинка?

         Set rng = .Item(ii).Range.Duplicate ' запомним место

         .Item(ii).Delete 'удалим картинку

         rng.Text = "[img]image" & nn & ".tif[/img]" 'Впишем название

         nn = nn - 1 'Уменьшим счётчик картинок

       End If

     Next ii

   End If

  End With

End Sub