The Problem:
Our employees are most of the time buying stuff in Inches and cm/mm, and our customers operate mostly in Inches, which make some unnecessary misunderstandings. So, I need a way to convert the CM into the Inches and the fraction of inches. The problem is by the way perfectly described in this linked video: 
The first column is a primary key auto number record ID, the second column is a short text for the inches and fractions, the third and fourth columns are Double numbers where the inches are represented as cm and mm, and the fifth column is used when the select the inches in a form based on 2 combo boxes. The other way is solved already by selecting the inches and fraction of inches on the form. As in the example below, the employees select 3 ¼ Inches by selecting ID 20 and 5 from the table, and this is added up and rounded to 83 mm.
What I need: A way to convert as in the example above 83 mm to 3 ¼ inches in Access VBA. (Decimal values are not durable, as described earlier and in the video.) I need to look up the nearest LOWER value to 83 mm in the table, which again would be ID 20 and 76.2 mm, and leave the variance 6.8 (83-76.2=6.8) to look up the nearest fraction of an inch LOWER or HIGHER, which in this case is 6.35 mm accordingly ID 5.
Thanks in advance for a way or solution. ;-)
CodePudding user response：
First, the inches must be parsed to obtain a decimal value:
Inches = "3"" 1/4"""
DecimalInches = ParseFeetInches(Inches)
? DecimalInches
3.25
Next, convert to millimeters:
Millimeters = MeterInch(DecimalInches) * 1000
? Millimeters
82.55
Finally, round up:
IntegerMillimeters = RoundUp(Millimeters)
? IntegerMillimeters
83
The functions, where you will notice the intense use of data type Decimal to keep an extreme precision:
' Parse a string for a value of feet and/or inches.
' The inch part can contain a fraction or be decimal.
' Returns the parsed values as decimal inches.
' For unparsable expressions, zero is returned.
'
' Maximum returned value is /- 7922816299999618530273437599.
' Negative values will only be read as such, if the first
' non-space character is a minus sign.
'
' Smallest reliably parsed value is the fraction 1/2097152
' or the decimal value 0.000000476837158203125.
'
' Requires when not used in Access, for example Excel,
' either:
' Module Access
' or a reference to Access, for example for Access 2016:
' Microsoft Access 16.0 Object Library
'
' 2018-04-19. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ParseFeetInches( _
ByVal Expression As String) _
As Variant
Dim ReplaceSets(20, 1) As String
Dim ExpressionParts As Variant
Dim ExpressionOneParts As Variant
Dim Sign As Variant
Dim DecimalInteger As Variant
Dim DecimalFraction As Variant
Dim DecimalInches As Variant
Dim Index As Integer
Dim Character As String
Dim FeetInches As String
Dim ExpressionOne As String
Dim ExpressionOneOne As String
Dim ExpressionOneTwo As String
Dim ExpressionTwo As String
Dim Numerator As Long
Dim Denominator As Long
' Read sign.
Sign = Sgn(Val(Expression))
' Trim double spacing.
While InStr(Expression, " ") > 0
Expression = Replace(Expression, " ", " ")
Wend
' Replace foot units.
ReplaceSets(0, 0) = "feet"
ReplaceSets(0, 1) = "'"
ReplaceSets(1, 0) = "foot"
ReplaceSets(1, 1) = "'"
ReplaceSets(2, 0) = "ft."
ReplaceSets(2, 1) = "'"
ReplaceSets(3, 0) = "ft"
ReplaceSets(3, 1) = "'"
ReplaceSets(4, 0) = Chr(SmartSingleQuote) ' Smart Quote: "’"
ReplaceSets(4, 1) = "'"
ReplaceSets(5, 0) = " '"
ReplaceSets(5, 1) = "'"
' Replace inch units.
ReplaceSets(6, 0) = "inches"
ReplaceSets(6, 1) = """"
ReplaceSets(7, 0) = "inch."
ReplaceSets(7, 1) = """"
ReplaceSets(8, 0) = "inch"
ReplaceSets(8, 1) = """"
ReplaceSets(9, 0) = "in."
ReplaceSets(9, 1) = """"
ReplaceSets(10, 0) = "in"
ReplaceSets(10, 1) = """"
ReplaceSets(11, 0) = Chr(SmartDoubleQuote) ' Smart Quote: "”"
ReplaceSets(11, 1) = """"
ReplaceSets(12, 0) = "''"
ReplaceSets(12, 1) = """"
' Replace decimal separator.
ReplaceSets(13, 0) = ","
ReplaceSets(13, 1) = "."
' Replace units with operators.
ReplaceSets(14, 0) = """"
ReplaceSets(14, 1) = ""
ReplaceSets(15, 0) = "'"
ReplaceSets(15, 1) = "*" & CStr(InchesPerFoot) & " "
' Remove divider spaces.
ReplaceSets(16, 0) = " /"
ReplaceSets(16, 1) = "/"
ReplaceSets(17, 0) = "/ "
ReplaceSets(17, 1) = "/"
' Replace disturbing characters with neutral operator.
ReplaceSets(18, 0) = " "
ReplaceSets(18, 1) = " "
ReplaceSets(19, 0) = "-"
ReplaceSets(19, 1) = " "
ReplaceSets(20, 0) = " "
ReplaceSets(20, 1) = " 0"
' Add leading neutral operator.
Expression = " 0" & Expression
' Apply all replace sets.
For Index = LBound(ReplaceSets, 1) To UBound(ReplaceSets, 1)
Expression = Replace(Expression, ReplaceSets(Index, 0), ReplaceSets(Index, 1))
Next
' Remove any useless or disturbing character.
For Index = 1 To Len(Expression)
Character = Mid(Expression, Index, 1)
Select Case Character
Case "0" To "9", "/", " ", "*", "."
FeetInches = FeetInches & Character
End Select
Next
' For unparsable expressions, return 0.
On Error GoTo Err_ParseFeetInches
ExpressionParts = Split(FeetInches, "/")
If UBound(ExpressionParts) = 0 Then
' FeetInches holds an integer part only, for example, " 00 038*12 0 05".
' Evaluate the cleaned expression as is.
DecimalInches = Sign * CDec(Eval(FeetInches))
Else
' FeetInches holds, for example, " 00 038*12 0 05 03/2048 0".
' For a maximum of decimals, split it into two parts:
' ExpressionOne = " 00 038*12 0 05 03"
' ExpressionTwo = "2048 0"
' or Eval would perform the calculation using Double only.
ExpressionOne = ExpressionParts(0)
ExpressionTwo = ExpressionParts(1)
' Split ExpressionOne into the integer part and the numerator part.
ExpressionOneParts = Split(StrReverse(ExpressionOne), " ", 2)
' Retrieve the integer part and the numerator part.
' ExpressionOneOne = " 00 038*12 0 05"
' ExpressionOneTwo = "03"
ExpressionOneOne = StrReverse(ExpressionOneParts(1))
ExpressionOneTwo = StrReverse(ExpressionOneParts(0))
' Extract numerator and denominator.
If Trim(ExpressionOneOne) = "" Then
' No integer expression is present.
' Use zero.
ExpressionOneOne = "0"
End If
Numerator = Val(ExpressionOneTwo)
Denominator = Val(ExpressionTwo)
' Evaluate the cleaned expression for the integer part.
DecimalInteger = CDec(Eval(ExpressionOneOne))
' Calculate the fraction using CDec to obtain a maximum of decimals.
If Denominator = 0 Then
' Cannot divide by zero.
' Return zero.
DecimalFraction = CDec(0)
Else
DecimalFraction = CDec(Numerator) / CDec(Denominator)
End If
' Sum and sign the integer part and the fraction part.
DecimalInches = Sign * (DecimalInteger DecimalFraction)
End If
Exit_ParseFeetInches:
ParseFeetInches = DecimalInches
Exit Function
Err_ParseFeetInches:
' Ignore error and return zero.
DecimalInches = CDec(0)
Resume Exit_ParseFeetInches
End Function
' Converts a value for a measure in inches to meters.
' Returns 0 (zero) for invalid inputs.
'
' Will convert any value within the range of Decimal
' with the precision of Decimal.
' Converts values exceeding the range of Decimal as
' Double.
'
' Largest value with full 28-digit precision is 1E 26
' Smallest value with full 28-digit precision is 1E-24
'
' Examples:
' Inch = 40.0
' Meter = MeterInch(Inch)
' Meter -> 1.016
'
' Inch = 1 / MetersPerInch ' Double.
' Inch -> 39.3700787401575
' Meter = MeterInch(Inch)
' Meter -> 1.0000000000000005
'
' Inch = CDec(1) / MetersPerInch ' Decimal.
' Inch -> 39.370078740157480314960629921
' Meter = MeterInch(Inch)
' Meter -> 1.0
'
' 2018-04-09. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function MeterInch( _
ByVal Value As Variant) _
As Variant
Dim Result As Variant
If IsNumeric(Value) Then
On Error Resume Next
Result = CDec(Value) * MetersPerInch
If Err.Number <> 0 Then
' Decimal overflow.
' Calculate without conversion to Decimal.
Result = CDbl(Value) * MetersPerInch
End If
Else
Result = 0
End If
MeterInch = Result
End Function
' Rounds Value up with count of decimals as specified with parameter NumDigitsAfterDecimal.
'
' Rounds to integer if NumDigitsAfterDecimal is zero.
'
' Optionally, rounds negative values away from zero.
'
' Uses CDec() to prevent bit errors of reals.
'
' Execution time is about 0.5µs for rounding to integer,
' else about 1µs.
'
' 2018-02-09. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RoundUp( _
ByVal Value As Variant, _
Optional ByVal NumDigitsAfterDecimal As Long, _
Optional ByVal RoundingAwayFromZero As Boolean) _
As Variant
Dim Scaling As Variant
Dim ScaledValue As Variant
Dim ReturnValue As Variant
' Only round if Value is numeric and ReturnValue can be different from zero.
If Not IsNumeric(Value) Then
' Nothing to do.
ReturnValue = Null
ElseIf Value = 0 Then
' Nothing to round.
' Return Value as is.
ReturnValue = Value
Else
If NumDigitsAfterDecimal <> 0 Then
Scaling = CDec(Base10 ^ NumDigitsAfterDecimal)
Else
Scaling = 1
End If
If Scaling = 0 Then
' A very large value for NumDigitsAfterDecimal has minimized scaling.
' Return Value as is.
ReturnValue = Value
ElseIf RoundingAwayFromZero = False Or Value > 0 Then
' Round numeric value up.
If Scaling = 1 Then
' Integer rounding.
ReturnValue = -Int(-Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
On Error Resume Next
ScaledValue = -Int(CDec(-Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ScaledValue = -Int(-Value * Scaling)
ReturnValue = ScaledValue / Scaling
End If
End If
Else
' Round absolute value up.
If Scaling = 1 Then
' Integer rounding.
ReturnValue = Int(Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
On Error Resume Next
ScaledValue = Int(CDec(Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ScaledValue = Int(Value * Scaling)
ReturnValue = ScaledValue / Scaling
End If
End If
End If
If Err.Number <> 0 Then
' Rounding failed because values are near one of the boundaries of type Double.
' Return value as is.
ReturnValue = Value
End If
End If
RoundUp = ReturnValue
End Function
The reverse conversion:
Millimeters = 83
Inches = InchMeter(Millimeters / 1000)
? Inches
3.2677165354330708661417322835
TextInches = FormatFeetInches(Inches, 4, "i r""")
? TextInches
3 1/4"
Full code is on GitHub: VBA.Round.
Full documentation:
Convert and format imperial distance (feet and inches) with high precision
Rounding values up, down, by 4/5, or to significant figures
and also:
CodePudding user response：
If all you want is to convert mms inches (text) with fractions, you can use a VBA function like:
Public Function MM2InchText(fMm As Integer) As String
Dim strRetVal As String, intInch As Integer, intFracNom As Integer, intDenom As Integer
intInch = Int(fMm / 25.4)
intDenom = 16 ' highest precision
intFracNom = Int((fMm - (intInch * 25.4)) / 25.4 * intDenom)
If intFracNom Mod 2 = 0 Then
intFracNom = intFracNom / 2
intDenom = intDenom / 2
If intFracNom Mod 2 = 0 Then
intFracNom = intFracNom / 2
intDenom = intDenom / 2
End If
End If
MM2InchText = IIf(intInch = 0, "", CStr(intInch) & " ") & IIf(intFracNom = 0, "", " " & CStr(intFracNom) & "/" & CStr(intDenom) & """")
End Function
You can call the function from other VBA code, from SQL queries/forms, using something like (to print to immediate window)
debug.print MM2InchText(83)
prints: 3 1/4"