A
AFSSkier
I need some expert help with a VBA code. On a form I would like to have the
user input a TYPE-E UPC into an unbound txtbx UPCE and after clicking a
CmdBttn, have the following code input the result of a Type-A UPC into
unbound txtbx UPCA & the skip digit into unbound txtbx UPCSkip.
VBA Source: Differences between Type A and Type E UPCs at
http://www.taltech.com/TALtech_web/resources/intro_to_bc/bcsymbol.htm#UPC
Function UPCE2A(UPCE As String) As String
' check the validity of the input data
If Not IsNumeric(UPCE) Then
MsgBox ("UPC Codes must contain Numeric Data Only!")
Exit Sub
End If
Select Case Len(UPCE)
Case 6 ' do nothing everything is OK
UPCEString$ = UPCE
Case 7
UPCEString$ = Left$(UPCE, 6)
' truncate last digit - assume that it is the UPCE check digit
Case 8
UPCEString$ = Mid$(UPCE, 2, 6)
' truncate first and last digit
' assume that the first digit is the number system digit
' and the last digit is the UPCE check digit
Case Else
MsgBox "wrong size UPCE message"
Exit Sub
End Select
' break up the string into its 6 individual digits
Digit1$ = Mid$(UPCEString$, 1, 1)
Digit2$ = Mid$(UPCEString$, 2, 1)
Digit3$ = Mid$(UPCEString$, 3, 1)
Digit4$ = Mid$(UPCEString$, 4, 1)
Digit5$ = Mid$(UPCEString$, 5, 1)
Digit6$ = Mid$(UPCEString$, 6, 1)
Select Case Digit6$ ' expand the 6 digit UPCE number to a 12 digit UPCA
number
Case "0", "1", "2"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit6$ + "00"
ItemNumber$ = "00" + Digit3$ + Digit4$ + Digit5$
Case "3"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + "00"
ItemNumber$ = "000" + Digit4$ + Digit5$ ' original code
was in error
Case "4"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + Digit4$ + "0"
ItemNumber$ = "0000" + Digit5$ ' original code was in
error
Case Else
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + Digit4$ + Digit5$
ItemNumber$ = "0000" + Digit6$
End Select
' put the number system digit "0" together with the manufacturer code and
Item number
Msg$ = "0" + ManufacturerNumber$ + ItemNumber$
' calculate the check digit - note UPCE and UPCA check digits are the same
Check% = 0 ' initialize the check digit value
For X% = 1 To 11
Test$ = Mid$(Msg$, X%, 1)
Select Case X%
Case 1, 3, 5, 7, 9, 11
Check% = Check% + Val(Test$) * 7 ' odd position digits
multiplied by 7
Case 2, 4, 6, 8, 10
Check% = Check% + Val(Test$) * 9 ' even position digits
multiplied by 9
End Select
Next
Check% = (Check% Mod 10) + 48 ' convert value to ASCII character value
CheckChar$ = Chr$(Check%) ' check character
UPCE2A = Msg$ + CheckChar$ ' put the pieces together and return
End Function
VBA Source: Differences between Type A and Type E UPCs at
http://www.taltech.com/TALtech_web/resources/intro_to_bc/bcsymbol.htm#UPC
user input a TYPE-E UPC into an unbound txtbx UPCE and after clicking a
CmdBttn, have the following code input the result of a Type-A UPC into
unbound txtbx UPCA & the skip digit into unbound txtbx UPCSkip.
VBA Source: Differences between Type A and Type E UPCs at
http://www.taltech.com/TALtech_web/resources/intro_to_bc/bcsymbol.htm#UPC
Function UPCE2A(UPCE As String) As String
' check the validity of the input data
If Not IsNumeric(UPCE) Then
MsgBox ("UPC Codes must contain Numeric Data Only!")
Exit Sub
End If
Select Case Len(UPCE)
Case 6 ' do nothing everything is OK
UPCEString$ = UPCE
Case 7
UPCEString$ = Left$(UPCE, 6)
' truncate last digit - assume that it is the UPCE check digit
Case 8
UPCEString$ = Mid$(UPCE, 2, 6)
' truncate first and last digit
' assume that the first digit is the number system digit
' and the last digit is the UPCE check digit
Case Else
MsgBox "wrong size UPCE message"
Exit Sub
End Select
' break up the string into its 6 individual digits
Digit1$ = Mid$(UPCEString$, 1, 1)
Digit2$ = Mid$(UPCEString$, 2, 1)
Digit3$ = Mid$(UPCEString$, 3, 1)
Digit4$ = Mid$(UPCEString$, 4, 1)
Digit5$ = Mid$(UPCEString$, 5, 1)
Digit6$ = Mid$(UPCEString$, 6, 1)
Select Case Digit6$ ' expand the 6 digit UPCE number to a 12 digit UPCA
number
Case "0", "1", "2"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit6$ + "00"
ItemNumber$ = "00" + Digit3$ + Digit4$ + Digit5$
Case "3"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + "00"
ItemNumber$ = "000" + Digit4$ + Digit5$ ' original code
was in error
Case "4"
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + Digit4$ + "0"
ItemNumber$ = "0000" + Digit5$ ' original code was in
error
Case Else
ManufacturerNumber$ = Digit1$ + Digit2$ + Digit3$ + Digit4$ + Digit5$
ItemNumber$ = "0000" + Digit6$
End Select
' put the number system digit "0" together with the manufacturer code and
Item number
Msg$ = "0" + ManufacturerNumber$ + ItemNumber$
' calculate the check digit - note UPCE and UPCA check digits are the same
Check% = 0 ' initialize the check digit value
For X% = 1 To 11
Test$ = Mid$(Msg$, X%, 1)
Select Case X%
Case 1, 3, 5, 7, 9, 11
Check% = Check% + Val(Test$) * 7 ' odd position digits
multiplied by 7
Case 2, 4, 6, 8, 10
Check% = Check% + Val(Test$) * 9 ' even position digits
multiplied by 9
End Select
Next
Check% = (Check% Mod 10) + 48 ' convert value to ASCII character value
CheckChar$ = Chr$(Check%) ' check character
UPCE2A = Msg$ + CheckChar$ ' put the pieces together and return
End Function
VBA Source: Differences between Type A and Type E UPCs at
http://www.taltech.com/TALtech_web/resources/intro_to_bc/bcsymbol.htm#UPC