CODEWITHSUNDEEP
vbams-word
Don Pablo
Don Pablo

Reputation: 1

How do I extract the line my selection.find found? It will only return to me the first character

In the following code I am trying to insert a picuture into my word document based on the text I found while searchiung. The problem is it will only return to me the firsat character od the text. How do I get all of the text? How do I get the actual line it was found in? The text I am looking for is directly after the text found. IE: "Insert screen shot here of Boxshot" So I am trying to load a file called Boxshot. NOT working. Help.

Sub NewPic()
'
' NewPic Macro
'
Dim screenshot, Dirname, selfound As String
Dim Dn As Long
'
 With Selection.Find
 .Text = "Insert screen shot here of "
 '.Replacement.Text = ""
 .Forward = True
End With
Selection.Find.Execute
'
'Insert picture and find next match
'
While Selection.Find.Found
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Select
selfound = Selection.Characters.First
MsgBox ("Text=" & selfound)
'
'Is picture there?
'
Dirname = ActiveDocument.Name
Dn = InStr(Dirname, "User")
Dirname = Left(Dirname, Dn)
screenshot = "C:\Users\User 1\Desktop\VB Upload files\CD's\" & Dirname & "\" & 
Selection.Text & ".jpg"
MsgBox ("Screenshot= " & screenshot & ", Sellectedtext=" & Selection.Text)
'
If Dir(screenshot) <> "" Then
    
Else
    screenshot = "C:\Users\User 1\Desktop\Mylogo.jpg"
End If
'
Selection.InlineShapes.AddPicture FileName:= _
    screenshot, LinkToFile:=False, SaveWithDocument _
    :=True
     '"C:\Users\User 1\Desktop\Mylogo.jpg", LinkToFile:=False, SaveWithDocument _
    ':=True
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1
    Selection.TypeParagraph
    Selection.Find.Execute
 Wend
 '
 End Sub

Upvotes: 0

Views: 65

Answers (1)

macropod
macropod

Reputation: 13490

Your use of Selection makes your code unnecessarily complex and slow. The following macro will insert the relevant pictures wherever "Insert screen shot here of " is followed by the pic name (no error-checking for valid names & files). If you don't want to retain the pic names below the pics, simply un-comment the commented-out line.

Sub NewPics()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Insert screen shot here of "
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindContinue
  End With
  Do While .Find.Execute
    .Text = vbCr
    .Collapse wdCollapseEnd
    .End = .Paragraphs.Last.Range.End - 1
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .InlineShapes.AddPicture FileName:=ActiveDocument.Path & "\" & .Text & ".jpg", LinkToFile:=False, SaveWithDocument:=True
    '.Start = .Start + 1: .Delete
  Loop
 End With
Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions