![]() |
|
#1
|
|||
|
|||
|
Hi there,
This is my first question and I think it should be easy enough if I can get some quick pointers in the right direction. Not too familiar with VBA in word (2007). Here is the outline for what I wish to accomplish: (1) Find each instance of "gpm" in my document. // gpm = gallons per minute (2) Find the numerical value preceding this instance (engVal). (3) Convert this value by multiplying it by a new value metVal = engVal * 3.785 //convert to liters per minute (4) Replace the "engVal gpm" string by "engVal gpm (metVal lpm)" (5) Go to the next instance of "gpm" and ask whether to replace or not. I rather manually confirm than do the whole document at once since there might be instances of "gpm" (table column headers) where I don’t want to replace it. When I know how to do this for “gpm”, I can use it for other unit conversions as well. Any help would be highly appreciated. Kindest Regards, Jaap |
|
#2
|
|||
|
|||
|
Something like this should get you started:
Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range, oRngNums As Range
Dim strNums As String
Dim arrEng() As String, arrMet() As String, arrFactors() As String
Dim lngIndex As Long
arrEng = Split("gpm,mph,yds", ",")
arrMet = Split("lpm,kph,m", ",")
arrFactors = Split("3.785,1.60934,.9144", ",")
For lngIndex = 0 To UBound(arrEng)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = arrEng(lngIndex)
While .Execute
oRng.Select
If MsgBox("Do you want to show dual values?", vbYesNo, "CREATE DUAL VALUE") = vbYes Then
Set oRngNums = oRng.Duplicate
oRngNums.Collapse wdCollapseStart
oRngNums.MoveStartWhile Cset:="1234567890 ", Count:=wdBackward
strNums = Trim(oRngNums.Text)
oRng.Text = arrEng(lngIndex) & " (" & CDbl(arrFactors(lngIndex)) * CDbl(strNums) & " " & arrMet(lngIndex) & ")"
oRng.Collapse wdCollapseEnd
Else
oRng.Collapse wdCollapseEnd
End If
Wend
End With
Next lngIndex
End Sub
|
|
#3
|
|||
|
|||
|
Thanks that is a great start, how do I add an exit to the msgbox if I want to quit without having to go through thw whole document
|
|
#4
|
|||
|
|||
|
Code:
While .Execute
oRng.Select
Select Case MsgBox("Do you want to show dual values?", vbYesNoCancel, "CREATE DUAL VALUE")
Case vbYes
Set oRngNums = oRng.Duplicate
oRngNums.Collapse wdCollapseStart
oRngNums.MoveStartWhile Cset:="1234567890 ", Count:=wdBackward
strNums = Trim(oRngNums.Text)
oRng.Text = arrEng(lngIndex) & " (" & CDbl(arrFactors(lngIndex)) * CDbl(strNums) & " " & arrMet(lngIndex) & ")"
oRng.Collapse wdCollapseEnd
Case vbNo
oRng.Collapse wdCollapseEnd
Case Else
Exit Sub
End Select
Wend
|
|
#5
|
|||
|
|||
|
OK I think I have it figured out pretty ok, I had to add some stuff to deal with periods and when a empty field is selected
Code:
Sub UnitConversion()
' This is a unit conversion macro that goes through a document and replaces english units by metric units
' followed by the english units in parathesis. This macro was orginally created by Greg Maxey and was later
' modified by Jaap de Vries 06/03/2014
'
' Initiate the variables
' ======================
' oRng will refers to the whole document,
' oRngNums Returns a read-only Range object that represents all the properties of the specified range.
' strEngVal Is a trimmed string that repreents the original number in English units
' strMetVal Is a trimmed string that repreents the original number in English units
' strTxtStrt String that gets utilized when there is a period found
' arrEng() array with English unit strings, Split("gpm,mph,yds", ",")
' arrMet() array with Metric unit strings, Split("lpm,kph,m", ",")
' arrFactors() Array of unit conversion factors, Split("3.785,1.60934,.9144", ",")
' intIndex interger value refrring to which unit is being converted as an index of arrEng()
' dblEngVal Double English unit value
' dblMetVal Double metric unit value
Dim oRng As Word.Range, oRngNums As Range
Dim strEngVal As String, strMetVal As String, strTxtStrt As String
Dim arrEng() As String, arrMet() As String, arrFactors() As String
Dim intIndex As Integer
Dim strResp As Integer
Dim dblEngVal As Double, dblMetVal As Double
' ======================
' Populate the English and metric units array plus the converion factors
arrEng = Split("gpm,mph,yds", ",")
arrMet = Split("lpm,kph,m", ",")
arrFactors = Split("3.785,1.60934,.9144", ",")
' Start by looking for the first English unit in arrEng(), which is gpm
For intIndex = 0 To UBound(arrEng)
' Select the whole document as the range
Set oRng = ActiveDocument.Range
'Perform a series of statements on the .Find object
With oRng.Find
' Find within the selected range text that matches the unit arrEng(intIndex)
.Text = arrEng(intIndex)
' Runs the specified find operation. Returns True if the find operation is successful.
While .Execute
' This is a range.select method that selects (highlights) the text that matches the arrEng(intIndex)
oRng.Select
' Create messagebox to as if you want to perfrom the unit conversion or not. Also allows to cancel alltogether
Select Case MsgBox("Do you want to show dual values?", vbYesNoCancel, "CREATE DUAL VALUE")
Case vbYes
' Create a duplicate of the range
Set oRngNums = oRng.Duplicate
' Collapse towards the beginning of the range
oRngNums.Collapse wdCollapseStart
' Moves the start position of the specified selection while any of the characters specified by Cset
' are found in the document.
oRngNums.MoveStartWhile Cset:=".1234567890 ", Count:=wdBackward
' Removes both both leading and trailing spaces from the obtained text
strEngVal = Trim(oRngNums.Text)
' If the results is an empty string then warn the user that there is no unit to convert
If strEngVal = "" Then
strResp = MsgBox("No units to convert!", vbOKOnly, "Warning")
Else
' Replace the original text with the one modified as follows.
' Check wether the period found is from regular punctuation
If InStr(1, strEngVal, ". ") Then
strEngVal = Replace(strEngVal, ". ", "")
strTxtStrt = ". "
Else
strTxtStrt = " "
End If
dblEngVal = CDbl(strEngVal)
dblMetVal = CDbl(arrFactors(intIndex)) * dblEngVal
' change the format of how the numbers should be represented
strMetVal = Format(dblMetVal, "###0")
' remove the english number
oRngNums.Text = ""
' Replace the old text with new string
oRng.Text = strTxtStrt & strMetVal & " " & arrMet(intIndex) & " (" & strEngVal & " " & arrEng(intIndex) & ")"
' move 'cursor' to end of the selection to continue searching the remiander of the document
oRng.Collapse wdCollapseEnd
End If
Case vbNo
' collapse the range and leaves at the end of the selection
oRng.Collapse wdCollapseEnd
Case vbCancel
' Cancel out of the subroutine
Exit Sub
End Select
Wend
End With
' Start looking for the next unit
Next intIndex
End Sub
|
|
#6
|
|||
|
|||
|
How can I start the range at the current cursor location?
|
|
#7
|
|||
|
|||
|
never mind
Code:
Set oRng = ActiveDocument.Range(Start:=Selection.Start) |
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
ch and line as measurement units
|
Aston | Word | 5 | 01-09-2020 04:19 PM |
How do I reset the default measurement units to cms
|
robin_ | Excel | 2 | 04-14-2014 10:36 PM |
Measurement units in Word
|
Aston | Word | 1 | 08-16-2013 06:10 PM |
Units not properly updated after a Finish Date Change
|
zi1 | Project | 1 | 08-04-2012 05:55 AM |
| Roll-Up Duration: Changing Units of Measure & Also Accuracy Of | Pmacdaddy | Project | 3 | 04-20-2012 07:13 AM |