Private Sub ОбластьДанных_Format(Cancel As Integer, FormatCount As Integer)
Dim s As String
s = "0" _
& DataToShtrih([prData], ,  3 ) _
& LongToShtrih([prEtVidProdID],  1 ) _
& LongToShtrih([prEtSortID],  1 ) _
& LongToShtrih([prEtNomer],  2 ) _
& LongToShtrih([prEtVorsID],  1 ) _
& LongToShtrih([prEtKolektID],  1 ) _
& LongToShtrih([prEtColorID],  3 ) _
& FloatToShtrih([prEtDlina],  3 ) _
& FloatToShtrih([prEtShirina],  2 )
s = s & ControlSymbol(s)

Me.ShtrihKod = "*" & s & "*"
End Sub

Option Compare Database
Option Explicit

Public Function ShtrihToLong(strShtrih As String, Optional osnov As Long =  43 ) As Long
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As Long
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez =  0 
    l = Len(strShtrih)
    For i = l To  1  Step - 1 
        rez = rez + osnov ^ (l - i) * (InStr( 1 , strCode39, Mid(strShtrih, i,  1 ), vbBinaryCompare) -  1 )
    Next i
    ShtrihToLong = rez
End Function
Public Function LongToShtrih(lngN As Long, Optional lenShtrih As Long =  1 , Optional osnov As Long =  43 ) As String
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As String
Dim ost As Long
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez = ""
    l = lngN
    While l >= osnov
        i = l Mod osnov
        rez = Mid(strCode39, i +  1 ,  1 ) & rez
        l = l \ osnov
    Wend
    i = l
    rez = Mid(strCode39, i +  1 ,  1 ) & rez
    While Len(rez) < lenShtrih
        rez = "0" & rez
    Wend
    LongToShtrih = rez
End Function
Public Function ShtrihToFloat(strShtrih As String, Optional nPoint As Long =  2 , Optional osnov As Long =  43 ) As Double
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As Double
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez =  0 
    l = Len(strShtrih)
    For i = l To  1  Step - 1 
        rez = rez + osnov ^ (l - i) * (InStr( 1 , strCode39, Mid(strShtrih, i,  1 ), vbBinaryCompare) -  1 )
    Next i
    
    ShtrihToFloat = rez / ( 10  ^ nPoint)
End Function

Public Function FloatToShtrih(floatN As Double, Optional nPoint As Long =  2 , Optional lenShtrih As Long =  3 , Optional osnov As Long =  43 ) As String
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As String
Dim ost As Long
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez = ""
    l = Int(floatN *  10  ^ nPoint)
    While l >= osnov
        i = l Mod osnov
        rez = Mid(strCode39, i +  1 ,  1 ) & rez
        l = l \ osnov
    Wend
    i = l
    rez = Mid(strCode39, i +  1 ,  1 ) & rez
    While Len(rez) < lenShtrih
        rez = "0" & rez
    Wend
    FloatToShtrih = rez
End Function
Public Function DataToShtrih(dataN As Date, Optional dataStart As Date = # 1 / 1 / 2000 #, Optional lenShtrih As Long =  3 , Optional osnov As Long =  43 ) As String
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As String
Dim ost As Long
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez = ""
    l = CLng(dataN - dataStart)
    If l <  0  Then DataToShtrih = "": Exit Function
    While l >= osnov
        i = l Mod osnov
        rez = Mid(strCode39, i +  1 ,  1 ) & rez
        l = l \ osnov
    Wend
    i = l
    rez = Mid(strCode39, i +  1 ,  1 ) & rez
    
    While Len(rez) < lenShtrih
        rez = "0" & rez
    Wend
    
    DataToShtrih = rez
End Function

Public Function ShtrihToData(strShtrih As String, Optional dataStart As Date = # 1 / 1 / 2000 #, Optional osnov As Long =  43 ) As Date
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As Double
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez =  0 
    l = Len(strShtrih)
    For i = l To  1  Step - 1 
        rez = rez + osnov ^ (l - i) * (InStr( 1 , strCode39, Mid(strShtrih, i,  1 ), vbBinaryCompare) -  1 )
    Next i
    
    ShtrihToData = dataStart + rez
End Function

Public Function ControlSymbol(strShtrih As String, Optional osnov As Long =  43 ) As String
Dim strCode39 As String
Dim i As Long
Dim l As Long
Dim rez As Long
Dim ost As Long
    strCode39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.$/+%_"
    rez =  0 
    l = Len(strShtrih)
    For i =  1  To l
        rez = rez + ShtrihToLong(Mid(strShtrih, i,  1 ))
    Next i
    ControlSymbol = LongToShtrih(rez Mod osnov)
End Function

Public Function ShtrihValid(strShtrih As String, Optional osnov As Long =  43 ) As Boolean
    If ControlSymbol(Left(strShtrih, Len(strShtrih) -  1 )) = Right(strShtrih,  1 ) Then
        ShtrihValid = True
    Else
        ShtrihValid = False
    End If
End Function