Visual Basic (MS Word 2007 macro)

November 15, 2009 at 13:16:21
Specs: Windows Vista
Hello,

I'm trying to create a macro in Word 2007 using VB (and I'm getting desperate by now).

The goal is to find and replace a string combined of number and currency (it always is in format "amount USD").

I have a text (a few pages - e.g. a contract) with some prizes, salaries, etc.

E.g.: The company will pay 400 USD to blah blah blah.

Now I need to create a macro which I could run that would automatically convert the value to EUR

So it would locate the value, multiply/divide it by a given number (exchange rate) and replace it with a new value and currency symbol; so the sentence would contain "362 EUR" instead of original "400 USD".

Length of the string can be different, as the values vary from 5 USD to thousands of USD

Thanks a lot for your help.


See More: Visual Basic (MS Word 2007 macro)

Report •


#1
November 15, 2009 at 15:46:32
I haven't seen too many Word macros posted in this forum.

VBA for Word is very different than VBA for Excel, so there's no one-to-one crossover.

You might try your question here...the Google groups version of a Word usenet group.

http://groups.google.com/group/micr...


Report •

#2
November 15, 2009 at 16:27:23
Hi,

I don't write a lot of Macros for Word, so I am not sure how robust this is.

Give it a try, but make sure you always have a backup!

(or two).

This Macro starts by asking for the exchange rate, then finds each instance of "USD"
and looks for the value before it.

It only takes whole numbers of dollars, but if necessary it could be modified.
As Word is text, the '.' is not considered a decimal point and
the whole number before and the decimal part are treated as two separate numbers.

If you have 25.00 USD or 50.50 USD consistently, i.e., always a number with decimals
it would be easy to modify.
If it is sometimes 25 USD and sometimes 25.20 USD then it will need a little more work.

Anyway here is the Macro

Option Explicit

Sub US2EU()

Dim strXRate As String
Dim sngXRate As Single
Dim sngEU As Single

On Error GoTo ErrHnd

'get current exchange rate
strXRate = InputBox("Enter US dollar to Euro Exchange rate", "Exchange Rate")
sngXRate = CSng(strXRate)

'go through document and find "USD"
With ActiveDocument.Content.Find
    .ClearFormatting
    Do While .Execute(FindText:="USD", Forward:=True, MatchWholeWord:=True, MatchCase:=True) = True
        With .Parent
            .Select
            'move insertion point back three words
            .Move Unit:=wdWord, Count:=-3
            .Select
            'make the dollar value the selection
            Selection.Next(Unit:=wdWord, Count:=1).Select
            'convert USD in text to value & multiple by exchange rate
            sngEU = CSng(Trim(Selection.Text)) * sngXRate
            'delete existing value and USD
            Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
            Selection.Range.Delete
            'insert new value and EUR
            Selection.InsertAfter " " & sngEU & " EUR"
        End With
    Loop
End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub

This was a sample source document:

This is a sample document.

We will pay everyone 10 USD.

If you are very good we will make it 20 USD, but if you don’t play nice, you will only get 5 USD.

and this is what it looked like after running the Macro with an exchange rate of 0.88

This is a sample document.

We will pay everyone 8.8 EUR.

If you are very good we will make it 17.6 EUR, but if you don't play nice, you will only get 4.4 EUR.

Regards


Report •

#3
November 15, 2009 at 19:42:44
Nice job Humar!

I don't know enough about VBA for Word to have started from scratch, so I took advantage of your hard work and modified the code to deal with both integer values and integer.decimal values.

Since the code for a period is Chr$(46), I move back 1 character after the value is selected and check to see if it's a period. If a "." is found, I then move back 1 word to find the integer portion, which by default makes the original value the decimal portion. I then concatenate the integer portion, the "." and the decimal portion to get the entire value. It's easier to see than to explain, so F8 through the code to see what I mean.

You can probably come up with a better way to delete the original value and usd than I did, but since I have no clue what I'm doing in VBA for word, I didn't know how to select the original value and "usd".

I couldn't use your method of MoveRight by a "word" since we don't know if the value will have a "period" in it. As I'm sure you know, MoveRight by one word would end up in a different spot if a "." was found.

Read my comments and F8 through the code and you'll see how I did it.

I'd like to see your improvements, since I learned a lot just by playing with the code you offered.

Option Explicit
Sub US2EU()

Dim strXRate As String
Dim sngXRate As Single
Dim sngEU As Single
Dim mySng As Single

On Error GoTo ErrHnd

'get current exchange rate
strXRate = InputBox("Enter US dollar to Euro Exchange rate", "Exchange Rate")
3 sngXRate = CSng(strXRate)

'go through document and find "USD"
With ActiveDocument.Content.Find
    .ClearFormatting
    Do While .Execute(FindText:="USD", Forward:=True, _
              MatchWholeWord:=True, MatchCase:=False) = True
        With .Parent
            .Select
            'move insertion point back three words
            .Move Unit:=wdWord, Count:=-3
            .Select
            'make the dollar value the selection
            Selection.Next(Unit:=wdWord, Count:=1).Select
            'convert USD in text to value & multiple by exchange rate
            ''Convert selection to value
              mySng = CSng(Trim(Selection.Text))
            ''Select previous character
              Selection.Next(Unit:=wdCharacter, Count:=-1).Select
            ''If it's a "." then select previous word, which is the integer portion
               If Selection = Chr$(46) Then
                Selection.Next(Unit:=wdWord, Count:=-1).Select
            ''Concatenate integer, decimal point and decimal portion
                mySng = Selection & "." & mySng
               End If
            ''Apply exchange rate
               sngEU = mySng * sngXRate
            'delete existing value and USD
            ''Find original value
              With ActiveDocument.Content.Find
               .Execute FindText:=mySng, Forward:=True, _
                MatchWholeWord:=True, MatchCase:=False
              End With
            ''Delete original value, then delete usd, character by character
            ''since we can't select by wdWord because we don't know if there
            ''is a decimal point in the value
               Do Until UCase(Selection) = "D"
                Selection.Range.Delete
               Loop
            ''Delete the d from usd
               Selection.Range.Delete
            'insert new value and EUR
            Selection.InsertAfter " " & sngEU & " EUR"
            .Move Unit:=wdWord, Count:=4
        End With
    Loop
    
End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub


Report •

Related Solutions

#4
November 15, 2009 at 20:11:29
BTW...There will be problems if there is a standalone usd without a numerical value in front of it.

Is there a FindNext equivalent in VBA for Word?

I added this line so that the conversion section of the code only runs if the "word" preceding the usd is a number:

If Selection Like "*#*" Then

It skips the conversion section when it should, but the .Find keeps finding the same standalone usd. I tried to move the Selection beyond the standalone usd before looping, but it didn't help.

How do you ignore a standalone usd and move forward to find the next usd and work on that one?


Report •

#5
November 15, 2009 at 22:12:58
Oh guys, thanks a lot :)
Haven't tried it yet, but the code makes a lot of sense!

Thank you very much!

By the way, there won't be a standalone "USD" in the document, as for standalone naming of the currecny the "U.S. dollar" version is used.


EDIT:
You guys are gods!
It works and it's great!
This just saved me hours of eye-bleeding manual find-replace and fingertip-bleeding calculator operating :)


Report •

#6
November 16, 2009 at 05:54:24
re: "You guys are gods!"

I can't speak for Humar, but I'm just a mere mortal who likes to play with code.

I'm just grateful that my higher power give me a modicum of talent so that I'm able to help others.

Most times I learn something in the process and that is certainly true in this case.


Report •

#7
November 16, 2009 at 06:03:59
Hi Cayo,

You're welcome. So glad it works.

DerbyDad03,

Thanks for the modifications. As I said I don't do many macros in Word, so it took longer to get it running, so certainly no frills in the code - like error checks to see if the text for conversion was a number, or that the conversion rate input was valid.

When I get time later today I will take a look at your mods in more detail.

I don't think that there is a find next, its just find with a do-while. The line

.Move Unit:=wdWord, Count:=4
wasn't needed in the final version (I made an edit after first posting), but it was there to move past the USD, as during testing I didn't delete USD, and had to move the insertion point forward.

One of the things I find difficult is remembering if Word VB functions select text after a move, or if it collapses the selection to a cursor or insertion point. Oddly even if a cursor or insertion point with no text is selected, Word returns a character count of 1.

Regards

Humar


Report •

#8
November 16, 2009 at 06:09:13
you've got to understand my happiness... :)

Two versions of working code just 6 hours after I posted the message - I spent the whole weekend trying to do this and all I got was find/replace the currency string (fyi, I'm in europe - I was posting the messagem in a very desperate state on sunday at about 10pm)...

And I learned a lot too... and will continue learning :)


Report •

#9
November 16, 2009 at 07:51:54
re: The line .Move Unit:=wdWord, Count:=4...was there to move past the USD

I tried something like that (it was late last night and I was beat) but it didn't seem to work.

For example, I tried a sample doc with a standalone usd like this:

I paid 10.52 usd.

The letters usd stand for U.S. Dollars.

You paid 12 usd.

The code would change the 10.52 used to xx.xx Eur, but once the code found the standalone usd in the second line, it just kept looping on it.

My check for Like "*#*" skipped the conversion section when it found the standalone usd, but even if I moved the curosr to a point beyond it, the code kept selecting it over and over again.

It appears that the .Find.Execute starts at the top of document everytime through the loop instead of continuing from the current location. At least it did for me.


Report •

#10
November 16, 2009 at 10:46:53
Hi Cayo,

I followed up on DerbyDad03's comments and added code to catch USD on its own, as well as numbers with decimals such as 10.50 USD. I know that you don't really need that, but I have added other enhancements as well:

I added a check to see that the exchange rate entered is a number. If it's not a number you get an option to try again (or quit).

Once there is a valid number, there is a confirmation box, with options to accept the rate, change it or quit the program.

As entering and checking the exchange rate adds time to each document conversion, I have added a multiple open dialog.

The Macro now starts by getting the exchange rate, and checking that its OK, then a file open dialog box is opened.

Selecting multiple Word documents in the file open dialog box will result in each one being opened, converted using the selected rate, saved and then closed.

I don't know if this will be of value to you, but it was fun to try, and it has helped me learn a bit more about VB in Word.


DerbyDad03,

I think that find does keep going from where it was rather than restarting from the beginning.

In the modified code, below, it handles a USD on its own, and doesn't hang. I have used :

.Move Unit:=wdWord, Count:=3
to move past the text.
Note that in the code below the search is for USD and is set to case sensitive, so it will ignore usd


Here is the revised code:

Sub US2EU()

Dim strXRate As String
Dim sngXRate As Single
Dim sngEU As Single
Dim varMsg As Variant
Dim dlgOpen As FileDialog
Dim varSelectedDoc As Variant

On Error GoTo ErrHnd
'*******************************************************
'get current exchange rate
GetRate:
strXRate = InputBox("Enter US dollar to Euro Exchange rate", "Exchange Rate")
'check that the text is recognizable as a number
If Not IsNumeric(strXRate) Then
    varMsg = MsgBox("Please enter a number", vbOKCancel, "Rate not recognizable")
    If varMsg = vbOK Then
        GoTo GetRate
        Else
        Exit Sub
    End If
End If
'check with user that the rate is OK & allow to quit program or change rate
varMsg = MsgBox("One US dollar is equal to " & Format(strXRate, "0.00####") & " Euros" & vbCrLf _
    & "Click No to change the rate" & vbCrLf & "or Cancel to quit the program", _
    vbYesNoCancel, "Confirm rate")
If varMsg = vbNo Then
    GoTo GetRate
End If
If varMsg = vbCancel Then
    Exit Sub
End If
'convert rate text to value
sngXRate = CSng(strXRate)
'*******************************************************
'open one or more documents
Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
With dlgOpen
    .AllowMultiSelect = True
    .Show
End With
'go through all selected documents
For Each varSelectedDoc In dlgOpen.SelectedItems
    'open selected document
    Documents.Open FileName:=varSelectedDoc
    '***************************************************
    'go through this document and find "USD"
    With ActiveDocument.Content.Find
        .ClearFormatting
        Do While .Execute(FindText:="USD", Forward:=True, MatchWholeWord:=True, MatchCase:=True) = True
            With .Parent
                .Select
                'move insertion point back three words
                .Move Unit:=wdWord, Count:=-3
                .Select
                'make the dollar value the selection
                Selection.Next(Unit:=wdWord, Count:=1).Select
                'test that the word is a number
                If IsNumeric(Trim(Selection.Text)) Then
                    'test if decimal point before number
                    If Selection.Next(Unit:=wdWord, Count:=-1) = Chr(46) Then
                        'move to number before decimal point
                        Selection.MoveLeft Unit:=wdWord, Count:=3
                        'now select three 'words' (integer, decimal point, decimal)
                        Selection.MoveRight Unit:=wdWord, Count:=3, Extend:=wdExtend
                    End If
                    'convert USD in text to value & multiply by exchange rate
                    sngEU = CSng(Trim(Selection.Text)) * sngXRate
                    'delete existing value and USD
                    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
                    Selection.Range.Delete
                    'insert new value and EUR
                    Selection.InsertAfter " " & sngEU & " EUR"
                    Else
                    'jump past USD with no number before it
                    .Move Unit:=wdWord, Count:=3
                End If
            End With
        Loop
    End With
    'save the changes and close the document
    ActiveDocument.Save
    ActiveDocument.Close
Next varSelectedDoc
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub

Again, this has had very limited testing, so if you use it please make sure you have backups.

Regards

Humar
PS If this Macro finds .25 USD it errors out - I should really put check in for this. 0.25 USD is OK


Report •

#11
November 16, 2009 at 11:23:48
I'll have to compare your solution to what I have my machine at home. I thought I tried something similiar to move past the the standalone usd, but obviously not.

Like I said, it was late, I had been painting, cleaning gutters and playing taxi driver all day plus I had the football game on while I was trying to code.

Obviously not one of the best times to be trying to learn VBA for Word!


Report •


Ask Question