View Single Post
 
Old 06-03-2014, 12:32 PM
JaapOnFire JaapOnFire is offline Windows 7 64bit Office 2007
Novice
 
Join Date: Jun 2014
Location: Boston
Posts: 5
JaapOnFire is on a distinguished road
Default

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
Reply With Quote