Attribute VB_Name = "تقريب"
Function mosuright(الرقم As Double) As Double
If الرقم > 999999999999.99 Then
mosuright = 0
Exit Function
End If
Dim x, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x14, x15, x16, x17, x18, x19 As Long
x = Format(الرقم, "000000000000.000000")
x12 = Mid$(x, 12, 1)
x14 = Mid$(x, 14, 1)
x15 = Mid$(x, 15, 1)
x16 = Mid$(x, 16, 1)
x17 = Mid$(x, 17, 1)
x18 = Mid$(x, 18, 1)
x19 = Mid$(x, 19, 1)
x11 = Mid$(x, 11, 1)
x10 = Mid$(x, 10, 1)
x9 = Mid$(x, 9, 1)
x8 = Mid$(x, 8, 1)
x7 = Mid$(x, 7, 1)
x6 = Mid$(x, 6, 1)
x5 = Mid$(x, 5, 1)
x4 = Mid$(x, 4, 1)
x3 = Mid$(x, 3, 1)
x2 = Mid$(x, 2, 1)
x1 = Mid$(x, 1, 1)
If x14 > 0 Or x15 > 0 Or x16 > 0 Or x17 > 0 Or x18 > 0 Or x19 > 0 Then
x14 = 0
x15 = 0
x16 = 0
x17 = 0
x18 = 0
x19 = 0
x12 = x12 + 1
    If x12 = 10 Then
    x12 = 0
    x11 = x11 + 1
        If x11 = 10 Then
        x11 = 0
        x10 = x10 + 1
            If x10 = 10 Then
            x10 = 0
            x9 = x9 + 1
                If x9 = 10 Then
                x9 = 0
                x8 = x8 + 1
                        If x8 = 10 Then
                        x8 = 0
                        x7 = x7 + 1
                               If x7 = 10 Then
                                x7 = 0
                                x6 = x6 + 1
                                      If x6 = 10 Then
                                      x6 = 0
                                      x5 = x5 + 1
                                            If x5 = 10 Then
                                            x5 = 0
                                            x4 = x4 + 1
                                                    If x4 = 10 Then
                                                    x4 = 0
                                                    x3 = x3 + 1
                                                        If x3 = 10 Then
                                                        x3 = 0
                                                        x2 = x2 + 1
                                                            If x2 = 10 Then
                                                            x2 = 0
                                                            x1 = x1 + 1
                                                            End If
                                                            End If
                                                    End If
                                            End If
                                      End If
                                End If
                       End If
                End If
            End If
        End If
    End If
mosuright = x1 & x2 & x3 & x4 & x5 & x6 & x7 & x8 & x9 & x10 & x11 & x12
Else
mosuright = الرقم
    
End If
End Function

