Question

我有以下代码：

1）打开一个对话框以选择图像文件

1）遍历所有活动/打开的文档

2）在每个文档的正文中搜索所有出现的FindText字符串，在文本的位置插入图像，并删除文本。（图像未调整大小/编辑） - 使用.InlineShapes.AddPicture

3）在文档开头后的几个页面中搜索每个文档标题，如果找到文本则插入图像，并删除文本。（图像重新调整大小，必须“在文本前面”，并且位于标题中的特定位置） - 使用.Shapes.AddPicture

此代码功能但不稳定。在打开的每个活动文档中都不会始终插入或找到图像/文本。此外，我不相信我使用正确的方法插入一个重新调整大小的图像，“在文本前面”，并定位在特定的位置。

我的两个问题：

如何使此代码稳定可靠？

插入图像是否正确？如果不是，我该如何解决问题？

Sub InsertImagesAllDocumentsV4()

Dim n, c As Integer
n = Application.Documents.Count
c = 1

Dim r As Range
Dim FindText As String
FindText = "[ImagePlaceHolder]"
Dim imageFullPath As String
'Open FileChooser
With Dialogs(wdDialogFileOpen)
    If .Display Then
       imageFullPath = WordBasic.FilenameInfo$(.Name, 1)
    Else
      MsgBox "No image selected"
      Exit Sub
    End If
End With


Windows(c).Activate


Do
   'Search body of document
    With Selection
    .HomeKey Unit:=wdStory
    With .Find
        .ClearFormatting
        .Text = FindText
        ' Loop until Word can no longer
        ' find the search string, inserting the specified image at each location
        Do While .Execute
            Selection.MoveRight
            Selection.InlineShapes.AddPicture FileName:=imageFullPath,        LinkToFile:=False, SaveWithDocument:=True
        Loop
    End With
End With


   'Search header of document and move to page 4
   Selection.MoveDown Unit:=wdScreen, Count:=4
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    With Selection
            .HomeKey Unit:=wdStory

            With .Find
                .ClearFormatting
                .Text = FindText
                ' Loop until Word can no longer
                ' find the search string, inserting the specified image at each location
                Do While .Execute
                    Selection.MoveRight
                    Dim SHP 'As Shape
                    Set SHP = ActiveDocument.Shapes.AddPicture(FileName:=imageFullPath, _
                        LinkToFile:=False, _
                        SaveWithDocument:=True, _
                        Left:=5, _
                        Top:=-20, _
                        Anchor:=Selection.Range)
                        With SHP
                           ''in front of text already converted'
                           '.ConvertToShape
                            'keep ratio
                            .LockAspectRatio = msoTrue
                            'adjust width to 0.5 inche
                            .Width = InchesToPoints(0.5)
                        End With
                Loop

            End With
        End With

    'Delete placholder text Main
    With Selection.Find
    .Text = FindText
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    End With
        Windows(c).Selection.Find.Execute Replace:=wdReplaceAll

' Exit header view
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


    'Delete placholder text header
    With Selection.Find
    .Text = FindText
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    End With
        Windows(c).Selection.Find.Execute Replace:=wdReplaceAll

    c = c + 1

    On Error Resume Next
    Windows(c).Activate

Loop Until c > n


End Sub

替换文本并插入图像Microsoft Word VBA的效率和可靠性

0 个答案: