Private Sub DrawBarcode(ByVal bc_string As String, sDescripcion As String, VLPrecio As String, obj As Control)
 
    Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
    Dim bc(90) As String
    Dim sAux As String
    Dim I As Byte
 
    bc(1) = "1 1221" 'pre-amble
    bc(2) = "1 1221" 'post-amble
    bc(48) = "11 221" 'dígitos
    bc(49) = "21 112"
    bc(50) = "12 112"
    bc(51) = "22 111"
    bc(52) = "11 212"
    bc(53) = "21 211"
    bc(54) = "12 211"
    bc(55) = "11 122"
    bc(56) = "21 121"
    bc(57) = "12 121"
 
    'Letras Mayúsculas
    bc(65) = "211 12" 'A
    bc(66) = "121 12" 'B
    bc(67) = "221 11" 'C
    bc(68) = "112 12" 'D
    bc(69) = "212 11" 'E
    bc(70) = "122 11" 'F
    bc(71) = "111 22" 'G
    bc(72) = "211 21" 'H
    bc(73) = "121 21" 'I
    bc(74) = "112 21" 'J
    bc(75) = "2111 2" 'K
    bc(76) = "1211 2" 'L
    bc(77) = "2211 1" 'M
    bc(78) = "1121 2" 'N
    bc(79) = "2121 1" 'O
    bc(80) = "1221 1" 'P
    bc(81) = "1112 2" 'Q
    bc(82) = "2112 1" 'R
    bc(83) = "1212 1" 'S
    bc(84) = "1122 1" 'T
    bc(85) = "2 1112" 'U
    bc(86) = "1 2112" 'V
    bc(87) = "2 2111" 'W
    bc(88) = "1 1212" 'X
    bc(89) = "2 1211" 'Y
    bc(90) = "1 2211" 'Z
 
    'Misceláneos Caracteres
    bc(32) = "1 2121" 'Espacio
    bc(35) = "" '# no se puede realizar
    bc(36) = "1 1 1 11" '$
    bc(37) = "11 1 1 1" '%
    bc(43) = "1 11 1 1" '+
    bc(45) = "1 1122" '-
    bc(47) = "1 1 11 1" '/
    bc(46) = "2 1121" '.
    bc(64) = "" '@ no se puede realizar
    bc(65) = "1 1221" '*
 
    bc_string = UCase(bc_string) 'Convertir a mayúsculas
 
    'Dimensiones
    obj.ScaleMode = 2 'Pixeles
    obj.Cls
    obj.Picture = Nothing
    dw = CInt(obj.ScaleHeight / 40) 'Espacio entre barras
    If dw < 1 Then dw = 1
    th = obj.TextHeight(bc_string) 'Alto texto
    tw = obj.TextWidth(bc_string) 'Ancho texto
    new_string = Chr$(1) & bc_string & Chr$(2) 'Agregar pre-amble, post-amble
    y1 = obj.ScaleTop + 12
    y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
    obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth
 
    'Dibujar cada caracter en el string barcode
    xpos = obj.ScaleLeft
    For n = 1 To Len(new_string)
            c = Asc(Mid(new_string, n, 1))
            If c > 90 Then c = 0
            bc_pattern$ = bc(c)
            'Dibujar cada barra
            For I = 1 To Len(bc_pattern$)
                Select Case Mid(bc_pattern$, I, 1)
                Case " "
                    'Espacio
                    obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
                    xpos = xpos + dw
                Case "1"
                    'Espacio
                    obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
                    xpos = xpos + dw
                    'Línea
                    obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
                    xpos = xpos + dw
                Case "2"
                    'Espacio
                    obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
                    xpos = xpos + dw
                    'Ancho línea
                    obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
                    xpos = xpos + 2 * dw
                End Select
            Next
    Next
 
    'Mas espacio
    obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
    xpos = xpos + dw
 
    'Medida final y tamaño
    obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
    obj.CurrentX = 1
    obj.CurrentY = 1
    If VLPrecio = "0.00" Then VLPrecio = ""
    If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sDescripcion) Then
        sAux = ""
        For I = 1 To Len(sDescripcion)
            If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sAux) Then
                Exit For
            Else
                sAux = sAux & Mid(sDescripcion, I, 1)
            End If
        Next I
        obj.Print sAux
    Else
        obj.Print sDescripcion
    End If
    obj.CurrentX = xpos - obj.TextWidth(VLPrecio)
    obj.CurrentY = 1
    obj.Print VLPrecio
    obj.CurrentX = (obj.ScaleWidth - tw) / 2
    obj.CurrentY = y2 + 0.25 * th
    obj.Print bc_string
 
    'Copiar a clipboard
    obj.Picture = obj.Image
    Clipboard.Clear
    Clipboard.SetData obj.Image, 2
 
End Sub
Private Sub Command1_Click()
    Call DrawBarcode(Trim("123456"), Trim("Cascara de Mango"), "0.00", Picture1)
End Sub