Зафиксировать количество цифр в числе

Sub QWERT()
Dim i, S
    For i = 2.99 To 3.01 Step 0.001
        S = S & vbCrLf & Format(i, "0.000")
    Next i
MsgBox S
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    'Проверка на номер !
    Dim s$
    Select Case KeyAscii
    Case 8: Exit Sub
    Case 44, 46, 225, 254
        KeyAscii = 44
    End Select
    With Text1(Index)
        s = Left$(.Text, .SelStart) & Chr(KeyAscii) & Mid$(.Text, .SelStart + 1)
    End With
    If Not IsNumeric(s) Then KeyAscii = 0
End Sub

 
Private Sub VScroll1_Change(Index As Integer)
    Dim d#, dd#, s$
    Static ign As Boolean
    If ign Then Exit Sub
    ign = 1: dd = 1
    d = Text1(Index).Text
    While InStr(1, CStr(d * dd), ",")
        dd = dd * 10
    Wend
    s = d + (VScroll1(Index).Value) / dd
    If Len(s) <> Len(Text1(Index)) Then
        s = d + (VScroll1(Index).Value * 2) / dd
    End If
    If s >= Text1(Index).Tag Then Text1(Index) = s
    VScroll1(Index).Value = 0
    ign = 0
End Sub

    If s >= Text1(Index).Tag Then Text1(Index) = s
    VScroll1(Index).Value = 0
    ign = 0

Private Function Summator(ByVal Num1$, ByVal Num2$) As String
    Dim n&, s$, nn&
    Num1 = Replace(Num1, ".", ",")
    n = InStr(1, Num1, ",")
    Summator = Replace(Num1, ",", vbNullString): s = Summator
    Summator = CDbl(Summator) + CDbl(Num2)
    If n Then
        nn = Len(Summator) - (Len(Num1) - n) + 1
        If nn < 1 Then nn = 1
        Summator = Left$(Summator, nn - 1) & "," & Mid$(Summator, nn)
        If Left$(Summator, 1) = "," Then Summator = "0" & Summator
    End If
End Function

Private Sub VScroll1_Change(Index As Integer)
    Dim s$
    Static ign As Boolean
    If ign Then Exit Sub
    ign = 1
    With Text1(Index)
        s = Summator(.Text, -VScroll1(Index).Value)
        If CDbl(s) >= .Tag Then .Text = s
    End With
    VScroll1(Index).Value = 0
    ign = 0
End Sub