VB Macro Find/Replace with {INSERTPICTURE} loop

Sorry, I was wrong. There are two functions that will not be in Word 97, Replace and InstrRev

This code from www.FreeVbCode.com can be used instead

You can add them alongside the macro.

Public Function InStrRev(ByVal sIn As String, ByVal _
   sFind As String, Optional nStart As Long = 1, _
    Optional bCompare As VbCompareMethod = vbBinaryCompare) _
    As Long

    Dim nPos As Long
   
    sIn = Reverse(sIn)
    sFind = Reverse(sFind)
   
    nPos = InStr(nStart, sIn, sFind, bCompare)
    If nPos = 0 Then
        InStrRev = 0
    Else
        InStrRev = Len(sIn) - nPos - Len(sFind) + 2
    End If
End Function

Public Function Join(Source() As String, _
    Optional sDelim As String = " ") As String

    Dim nC As Long
    Dim sOut As String
   
    For nC = LBound(Source) To UBound(Source) - 1
        sOut = sOut & Source(nC) & sDelim
    Next
   
    Join = sOut & Source(nC)
End Function

Public Function Replace(ByVal sIn As String, ByVal sFind As _
    String, ByVal sReplace As String, Optional nStart As _
     Long = 1, Optional nCount As Long = -1, _
     Optional bCompare As VbCompareMethod = vbBinaryCompare) As _
     String

    Dim nC As Long, nPos As Long
    Dim nFindLen As Long, nReplaceLen As Long

    nFindLen = Len(sFind)
    nReplaceLen = Len(sReplace)
   
    If (sFind <> "") And (sFind <> sReplace) Then
        nPos = InStr(nStart, sIn, sFind, bCompare)
        Do While nPos
            nC = nC + 1
            sIn = Left(sIn, nPos - 1) & sReplace & _
             Mid(sIn, nPos + nFindLen)
            If nCount <> -1 And nC >= nCount Then Exit Do
            nPos = InStr(nPos + nReplaceLen, sIn, sFind, _
              bCompare)
        Loop
    End If

    Replace = sIn
End Function

Thanks, GrahamSkan.  
Although, I don't understand where to put in my choices for the variables to search for and the web addresses to which they link.  I'm not a huge novice, but I need some more clarification, much like was done in  http://www.experts-exchange.com/Applications/MS_Office/Word/Q_20984704.html?query=find+replace+picture&topics=605.  

Or, does the page on freevbcode.com explain it?  If so, can you include the complete link?  
Thanks.

All I've actually done so far is to ensure that the macro would run in Word97.

I'll have another look in a few hours if no-one else has given you the answer by then.

And I didn't even do that. I only gave you two functions of those in the code. Wouldn't be a problem, except that one of the missing ones (Reverse) is called in the code I gave you.

The idea of the macro is that you make your pictures folder = to the sPath. You need to have double backslashes because the backslash is a special character in Word fields.

This is the full code (from http://www.freevbcode.com/ShowCode.Asp?ID=17)

'Split         Split a string into a variant array.
'
'InStrRev      Similar to InStr but searches from end of string.
'
'Replace       To find a particular string and replace it.
'
'Reverse       To reverse a string.

Public Function InStrRev(ByVal sIn As String, ByVal _
   sFind As String, Optional nStart As Long = 1, _
    Optional bCompare As VbCompareMethod = vbBinaryCompare) _
    As Long

    Dim nPos As Long
   
    sIn = Reverse(sIn)
    sFind = Reverse(sFind)
   
    nPos = InStr(nStart, sIn, sFind, bCompare)
    If nPos = 0 Then
        InStrRev = 0
    Else
        InStrRev = Len(sIn) - nPos - Len(sFind) + 2
    End If
End Function

Public Function Join(Source() As String, _
    Optional sDelim As String = " ") As String

    Dim nC As Long
    Dim sOut As String
   
    For nC = LBound(Source) To UBound(Source) - 1
        sOut = sOut & Source(nC) & sDelim
    Next
   
    Join = sOut & Source(nC)
End Function

Public Function Replace(ByVal sIn As String, ByVal sFind As _
    String, ByVal sReplace As String, Optional nStart As _
     Long = 1, Optional nCount As Long = -1, _
     Optional bCompare As VbCompareMethod = vbBinaryCompare) As _
     String

    Dim nC As Long, nPos As Long
    Dim nFindLen As Long, nReplaceLen As Long

    nFindLen = Len(sFind)
    nReplaceLen = Len(sReplace)
   
    If (sFind <> "") And (sFind <> sReplace) Then
        nPos = InStr(nStart, sIn, sFind, bCompare)
        Do While nPos
            nC = nC + 1
            sIn = Left(sIn, nPos - 1) & sReplace & _
             Mid(sIn, nPos + nFindLen)
            If nCount <> -1 And nC >= nCount Then Exit Do
            nPos = InStr(nPos + nReplaceLen, sIn, sFind, _
              bCompare)
        Loop
    End If

    Replace = sIn
End Function

Public Function Reverse(ByVal sIn As String) As String
    Dim nC As Long
    Dim sOut As String

    For nC = Len(sIn) To 1 Step -1
        sOut = sOut & Mid(sIn, nC, 1)
    Next nC
   
    Reverse = sOut
End Function

Public Function Split(ByVal sIn As String, _
    Optional sDelim As String = " ", _
    Optional nLimit As Long = -1, _
    Optional bCompare As VbCompareMethod = vbBinaryCompare) _
    As Variant

    Dim nC As Long, nPos As Long, nDelimLen As Long
    Dim sOut() As String
   
    If sDelim <> "" Then
        nDelimLen = Len(sDelim)
        nPos = InStr(1, sIn, sDelim, bCompare)
        Do While nPos
            ReDim Preserve sOut(nC)
            sOut(nC) = Left(sIn, nPos - 1)
            sIn = Mid(sIn, nPos + nDelimLen)
            nC = nC + 1
            If nLimit <> -1 And nC >= nLimit Then Exit Do
            nPos = InStr(1, sIn, sDelim, bCompare)
        Loop
    End If

    ReDim Preserve sOut(nC)
    sOut(nC) = sIn

    Split = sOut
End Function

I'm sorry but this still makes no sense to me:
Where in this code do I put the variable text strings I'm searching for?
Where in this code do I put the variable web addresses which link to the text strings.

e.g.,
If text "A" is found, it will link INSERTPICTURE field to website "Y" and display the picture.

Some may link to the same picture, ie, text "A" "B" and "C" all link to website "X"
No one text string will link to more than one picture though.  

Just tell me where exactly to put the search text string variables and the website variables, please.  

Thanks for your help!

Hi nheger,
I think that we we may be talking at cross-purposes here.

The macro that you described as nearly suiting your purpose will (under Word2000 &+) search a document for a text of a particular format that contains the name of a picture file to insert at that point. The picture file will be found in a given folder.

The text strings are inserted in the document, not the code.

There is no provision in the macro to get text via a URL, only a local folder. It may work. I don't know. You say that it is your intranet, so I suppose(d) that you can access the folder locally.

If you must use URLs to get to the pictures, perhaps you could instance a URL folder that we can test it with.

If not, perhaps we should start again from scratch. You can request, in the Community Support area, that this question be closed and your points refunded.

If you can further clarify your requirements, I am still willing to carry on working on this open question, but you should be aware that it is slipping down the list of open questions and I will probably be the only respondent.

All the best, Graham

Like Graham, I am not entirely sure of the precise requirements and parameters here.  I think that I may have re-written the macro that nheger originally referred to in such a way that it will accomplish what nheger is asking.

Since nheger wants to "tell" the code what to look for and what to like to, I wrote the following macro.

Nheger, you will need to change the values that are assigned to "Const nhegers_number_of_searches"
You will also need to "personalize" the values that are assigned to the array named nhegers_list()

You will notice that the array values come in pairs.  Hopefully it will make sense to you when you look below.  Currently, I have only included four pairs.  If you have 10 things to search for, then you need to add more pairs.  Just follow the pattern below.

Everything from the "For x" line on down should not require alteration.

There are TWO CAVEATS.  However, look at the code first, and then read my further comments below

Sub insPic()

Dim x

Const nhegers_number_of_searches = 3 'this allows for FOUR, because we start at ZERO

Dim nhegers_list(1, nhegers_number_of_searches)

nhegers_list(0, 0) = "Flammable " & Chr(150) & " Canada.bmp"
nhegers_list(1, 0) = "C:\\Folder of Pics\\Flammable - Canada.bmp"

nhegers_list(0, 1) = "Search For This 2"
nhegers_list(1, 1) = "Replace With File Path"

nhegers_list(0, 2) = "Search For This 3"
nhegers_list(1, 2) = "Replace With File Path"

nhegers_list(0, 3) = "Search For This 4"
nhegers_list(1, 3) = "Replace With File Path"


For x = 0 To nhegers_number_of_searches

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting

With Selection.Find
.Text = nhegers_list(0, x)
.Forward = True
.Wrap = wdFindContinue
End With

Do While Selection.Find.Execute

Selection.Fields.Add Range:=Selection.Range, _
Type:=wdFieldEmpty, Text:="INCLUDEPICTURE  " & """" & nhegers_list(1, x) & """"

Loop

Next

End Sub

THE TWO CAVEATS:

1. Note that paths (such as "C:\\Folder of Pics\\Flammable - Canada.bmp") must use "double slashes"

2. The spaces in your file names are not a problem, but the HYPHENS are potentially a very tricky problem.  If the hyphens show up IN THE WORD DOCUMENT TEXT as an "en dash" (Chr(150)) or an "em dash" (Chr(151)) rather than a hyphen, this can severly foul up your FIND operation.

Anyway, see what you think and then post back any questions for me.

I just noticed my own typo.  Where I wrote "what to like to," I meant to say "what to link to"

I've just now decided to start a campaign to ask all members to put more info in their profiles.

It is a big help to know your time-zone, Kelly_in_Los_Angeles.

Graham in London

Sorry, I just subscribed.

I'll go do my profile right away.

Thanks!!

Oh, wait.

Are you just teasing me about my handle?  (hee hee)

It's just that "Kelly" is so common I have to add something to it

Kelly
You don't have to apologise. I was actually thinking that your handle was as good as putting the information in your profile. I only have one language and I'm not too good with that.
Cheers, Graham

Kelly,

Thank you...this is what I was looking for!  It is quite easy to edit and for novice users (such as myself) to edit the macro to my needs.

One of my major concerns (which I thought I could fix myself) is not working correctly through this macro though.

I added in a line of code underneath the INCLUDEPICTURE part to add in a carriage return and to format the picture to the correct dimensions:

Selection.Fields.Add Range:=Selection.Range, _
Type:=wdFieldEmpty, Text:="INCLUDEPICTURE " & """" & nhegers_list(1, x) & """"
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.InlineShapes(1).Height = 48.25
        Selection.InlineShapes(1).Width = 48.95
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
        Selection.TypeParagraph

Since there are about 12 images which are placed in the document, they all need to be the same size.  For some reason though, it only formats some of them to this size, and leaves others their original size.  And then if I paste my text in again, and re-run the code, different ones are affected by the size change.  I don't understand why it does this?  Perhaps there's a better place to put the re-size picture command in the code?  Any thoughts?

Thanks for all your help!

Hi nheger!

I just woke up this morning, so as soon as I have some coffee I'll play around with image formatting and see what I can come up with.

I'm pretty sure the problem lies in referring to the shape by "index 1" (meaning the part about InlineShapes(1))

The best way would be if we could assign a user-defined range to each shape AS WE INSERT IT. (This is what I'll work on after coffee)

But the "easy" way might be to keep adding "+1" to the index (InlineShapes(1), InlineShapes(2))
I wonder if it would work to keep your code the way it is and then just put "InlineShapes(x+1).Height" and "InlineShapes(x+1).Width"  (I'm suggesting x+1 because x starts at 0)

oh!  one thing I should ask for sure:
          IMPORTANT QUESTION:  Are the pictures that are getting inserted **by the macro** the ONLY pictures in the document???   And a corollary-type question: whether or not the "macro pictures" are the only ones in the document... do you want ALL PICTURES in the ENTIRE document to recieve the same formatting?

If so, you could go all the way down to the end of the macro (just directly before the "End Sub") and add this:

Dim aPic As InlineShape

For Each aPic In ActiveDocument.InlineShapes

aPic.Height = 48.25
aPic.Width = 48.95
aPic.Select
Selection.InsertAfter Chr(13)   'note: Chr(13) is a carriage return or 'new paragraph'
Selection.InsertAfter Chr(13)

Next aPic

Gee!  I said I'd get my coffee before answering, and now that I think about it, that little "aPic" solution just might do the trick and I actually wrote it BEFORE coffee. <laughing>

Oh! I just wanted to clarify...

Obviously, If you add the "For Each aPic" loop to the very end of the macro, then you need to DELETE the following:

Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.InlineShapes(1).Height = 48.25
        Selection.InlineShapes(1).Width = 48.95
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
        Selection.TypeParagraph

The above stuff is duplicated in the aPic loop, so it wouldn't make sense to leave it in.

Hi Kelly,

Unfortunately, there are quite a few other pictures (of varying sizes) in the document .  I had already considered a macro to format all the pictures to the same size, but it turned out that some of the images became unclear after resizing.  

Maybe we will have to make a user-defined size for each picture?  What do you suggest?

Thanks,
Nick

Darn!!

It's okay, I think we can still swing it.

In that case, you were totally correct to place the formatting code where you put it.

Okay...  let me play around some more....

Hi Kelly,

I just talked to IT - seems that some of my icon pictures just have different resolution values, which are causing them to appear in different sizes on the documents, but appear fine on the intranet preview page.  Let me fix these so they're all the same values, see if this fixes the problem and let you know if I need further help.  Should only be another hour from now or so.  Thanks again! :)

Hi Nick!

I just read your message about the different resolution values.

Okay, I'll wait and see.  I'm crossing my fingers!

Hi Kelly,

IT just updated my pictures.  Now all the pictures are the same size, but too big.  Is there a way to alter the "myfield" code you used above and resize them to 50% of their original size?

Thanks again!

Oh wait...nevermind..it works!  (user error, of course!)

Thank you so VERY much!  Now, all I have to do is adapt this for some other cases...hmm - we'll see how that goes ;)

Thanks again!
-Nick

You're very welcome.

Glad to be of service.

Ugh...ok..now it's not working again?  I'm not sure why?  I even reduced the height and width numbers to 24?
When the run the macro the first time, it does not work.  Second time, only some work.  Third, maybe fourth, it works correctly.  Why is this?

Any ideas?

When you say you run it 2 or 3 or more times...  how can you do that?  after one time, aren't all the text strings replaced with pictures so that there is nothing to find and therefore nothing to replace nothing to insert and nothing to then format (cuz it was never inserted and selected)?

I'm confused.

OH, I repaste the text - i dont run the macro over and over.

I think I can actually live with it - it's not the end of the world.

Do you know how to "step through" a macro?

you should step through it to see what's going on.

the weird thing is that it is apparently running without generating any error messages, right?  and yet it doesn't work.

I'm willing to keep brainstorming if you need me.

Otherwise, if you're totally sick of this thing, then I'll see you again sometime on another question!

Ok.  I'll try the step through thing and let you know what I find ;)

When I step through it, everything works as it is supposed to.  When running the full macro, it doesn't always work right.  It's as if it's loading the pictures too fast.  Could it have anything to do with my work's intranet?  

Or, is there a way to assign an bookmark or unique Dim to each picture and then resize them all as the last step?

That's a good idea.

You know what...  you could even run them as TWO SEPARATE MACROS.  See what I have below, and I think you'll know what I mean.  If you divided the following code into two, then in the first macro, the find and replace could occur.  Then when that macro ended you could verify that all the pictures had finished loading or whatever.  Then run the second macro that cycles through the bookmarks.


Sub insPic()

Dim x

Const nhegers_number_of_searches = 3 'this allows for FOUR, because we start at ZERO

Dim nhegers_list(1, nhegers_number_of_searches)

nhegers_list(0, 0) = "Flammable " & Chr(150) & " Canada.bmp"
nhegers_list(1, 0) = "C:\\Folder of Pics\\Flammable - Canada.bmp"

nhegers_list(0, 1) = "Search For This 2"
nhegers_list(1, 1) = "Replace With File Path"

nhegers_list(0, 2) = "Search For This 3"
nhegers_list(1, 2) = "Replace With File Path"

nhegers_list(0, 3) = "Search For This 4"
nhegers_list(1, 3) = "Replace With File Path"


For x = 0 To nhegers_number_of_searches

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting

With Selection.Find
.Text = nhegers_list(0, x)
.Forward = True
.Wrap = wdFindContinue
End With

Do While Selection.Find.Execute

Dim myField As Field

Set myField = Selection.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, Text:="INCLUDEPICTURE  " & """" & nhegers_list(1, x) & """")

ActiveDocument.Bookmarks.Add "nhegerpictures" & x, myField.Code

Loop

Next

'**** possible division point would be right here.  you could start a new macro *********

'**** if you divided this into two macros, you would have to make sure to match up nhegers_number_of_searches

For y = 0 to nhegers_number_of_searches

ActiveDocument.Bookmarks("nhegerpictures" & y).Select

Selection.MoveRight wdCharacter, 1, True

Selection.InlineShapes(1).Height = 48.25
Selection.InlineShapes(1).Width = 48.95
Selection.InsertAfter Chr(13)
Selection.InsertAfter Chr(13)
ActiveDocument.Bookmarks("nhegerpictures" & y).Delete


Next y

End Sub

Hi Kelly,

I talked with a few people and they are fine with leaving the macro as it is (as there are no more than 3 of the pictures from the strings inserted into the document at any one point).  Also, I actually removed the manual carriage returns as it will save paper having the pictures appear next to each other.  If they need them to be substantially smaller, I'll give this a try, but I'll just leave it for now.  

Thanks!

Hi Nick,
I think you can increase the points at any time. I suggest that you do this just before accepting Kelly's final answer, whenever it comes. She's not let go of this one.
Cheers, Graham
 

Oops. It's already accepted. Not to worry.