Dim DocName
Dim Multiple, ConstCoef, Precise
Dim iCount
Dim FindUnitStr, RepUnitStr
Private Sub btnCancel_Click()
   frmReplaceNumber.Hide
End Sub

Private Sub btnOK_Click()
    On Error Resume Next
    If tbA.Text = "" Then
        MsgBox ("You have to enter at least a number for the slope!")
    Else
        If Selection.Type = wdSelectionIP Then
            ReplaceNumber
        Else
            NewDoc
            ReplaceNumber
            ReplaceDoc
        End If
    End If
    frmReplaceNumber.Hide
End Sub
Private Sub NewDoc()
    DocName = ActiveDocument.Name
    Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.WholeStory
    Selection.Paste
    Selection.HomeKey Unit:=wdStory
End Sub
Private Sub ReplaceDoc()
    Selection.WholeStory
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    Windows(DocName).Activate
    Selection.Paste
End Sub
Private Function isASpecificChar(AChar, SpecificChar)
    isASpecificChar = (Asc(AChar) = Asc(SpecificChar))
End Function
Private Function isADigit(Ch)
    isADigit = (Asc(Ch) >= Asc("0") And Asc(Ch) <= Asc("9"))
End Function
Private Sub ExtendingSelection2()
    iCount = 0
    isDigit = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Do
        isSpace = False
        If Selection.MoveLeft = 1 Then
            TempChar = Left(Selection.Text, 1)
            isSpace = isASpecificChar(TempChar, Chr(32))
            If isSpace Then
                FindUnitStr = TempChar + FindUnitStr
                RepUnitStr = TempChar + RepUnitStr
            Else
                isDigit = isADigit(TempChar)
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        End If
    Loop While isSpace
    While isDigit
        isDigit = False
        If Selection.MoveLeft = 1 Then
            TempChar = Left(Selection.Text, 1)
            isDigit = (isASpecificChar(TempChar, ".") Or isADigit(TempChar))
            If isDigit Then
                iCount = iCount + 1
            Else
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        End If
    Wend
    Selection.MoveRight Unit:=wdCharacter, Count:=iCount, Extend:=wdExtend
End Sub
Private Sub ExtendingSelection1()
    iCount = Len(Selection.Text)
    Do
        isDigit = False
        If Selection.MoveRight = 1 Then
            TempChar = Left(Selection.Text, 1)
            isDigit = isASpecificChar(TempChar, ".") Or isADigit(TempChar)
            If isDigit Then iCount = iCount + 1
        End If
    Loop While isDigit
    Selection.MoveLeft Unit:=wdCharacter, Count:=iCount
    If InStr(FindStr, "-") <> 1 Then ' if it is not a negative number, do the loop
        Do
            isDigit = False
            If Selection.MoveLeft = 1 Then
                TempChar = Left(Selection.Text, 1)
                isDigit = isASpecificChar(TempChar, ".") Or isADigit(TempChar)
                If isDigit Then
                    iCount = iCount + 1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            End If
        Loop While isDigit
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=iCount, Extend:=wdExtend
End Sub
Private Sub CalculateFormula()
    Dim TempDocName
    FormatStr = "#.00000000000000x"
    TempDocName = ActiveDocument.Name
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.WholeStory
    Selection.InsertFormula Formula:="=" & tbA.Text, NumberFormat:=FormatStr
    Selection.WholeStory
    Multiple = CDbl(Selection.Text)
    If tbB.Text <> "" Then
        Selection.InsertFormula Formula:="=" & tbB.Text, NumberFormat:=FormatStr
        Selection.WholeStory
        ConstCoef = CDbl(Selection.Text)
    End If
    If tbPrecise <> "" Then
        Selection.InsertFormula Formula:="=" & tbPrecise.Text, 
NumberFormat:=FormatStr
        Selection.WholeStory
        Precise = CDbl(Selection.Text)
    Else
        Precise = 2
    End If
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    Windows(TempDocName).Activate
End Sub
Private Sub CalculateNReplace()
    d = CDbl(Selection.Text)
    If (d <> 0) Then
        Value = d * Multiple + ConstCoef
        TempStr = CStr(Round(Value, Precise))
        If InStr(TempStr, ".") <> 0 Then
            While (Asc(Left(Right(TempStr, Precise + 1), 1)) <> Asc("."))
                TempStr = TempStr + "0"
            Wend
        ElseIf Precise > 0 Then
            TempStr = TempStr + "."
            For i = 1 To Precise
                TempStr = TempStr + "0"
            Next
        End If
        If MultiPage1.Value = 1 Then
            TempStr = TempStr + RepUnitStr
            Selection.MoveRight Unit:=wdCharacter, Count:=Len(FindUnitStr), 
Extend:=wdExtend
        End If
        Selection.Text = TempStr
    End If
End Sub
Private Sub ReplaceNumber()
    On Error Resume Next
    CalculateFormula
    FindStr = ""
    RepStr = ""
    Select Case MultiPage1.Value
    Case 0:
        FindStr = cobFindStr.Text
        RepStr = ""
    Case 1:
        FindStr = tbFindUnit.Text
        RepStr = tbRepUnit.Text
    End Select
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = FindStr
        .Replacement.Text = RepStr
        .Forward = True
        .Wrap = wdFindStop
    End With
    While Selection.Find.Execute
        Select Case MultiPage1.Value
        Case 0: ' by number
            If Not cbNoExtend.Value Then
                ExtendingSelection1
            End If
        Case 1: ' by unit
            FindUnitStr = FindStr
            RepUnitStr = RepStr
            ExtendingSelection2
        End Select
        If iCount > 0 Then CalculateNReplace
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Wend
End Sub

Private Sub UserForm_Initialize()
   Load frmReplaceNumber
   cobFindStr.AddItem ("^#.^#")
   cobFindStr.AddItem ("^#")
   cobFindStr.AddItem ("^#^#")
   cobFindStr.AddItem ("^#^#^#")
   cobFindStr.AddItem ("0.^#")
   cobFindStr.AddItem ("-^#.^#")
   cobFindStr.AddItem ("-^#")
End Sub

Sub ReplaceNumber()
    frmReplaceNumber.Show
End Sub