Veja se esta serve.

 

Option Explicit
'1cm ~480 tiwps; A folha tem ~ 21cm de Largura e 30cm de comprimento
'logo 10080 de largura por 14400 de comprimento
Dim Barcodes(9) As String
Dim I, j, k, CoordX, CoordY As Integer
Const MargemDireita = 184
Const MargemEsquerda = 6
Const MargemSuperior = 3
Const Fino = 16              ' largura da barra fina
Const Largo = 41             ' largura da barra larga
Const Altura = 737           ' 2.5 vezes a fina
Private Function Zeros(Num, Zr)
  Dim Znum
  Znum = Num
  For I = 1 To Zr - Len(Num)
    Znum = "0" & Znum
  Next
  Zeros = Znum
End Function
 
'Desenha o código de barras
Public Sub DesenhaBarra(Valor As String, Destino As Object, Optional CoordX As Integer, Optional CoordY As Integer)
    
  If IsEmpty(Valor) Or Valor = "" Then
     MsgBox "O parâmetro valor não deve ser vazio ou nulo !", vbCritical, "Erro na entrada de valores"
     Exit Sub
  End If
  If Len(Valor) > 44 Then
     MsgBox "O parâmetro valor não deve exceder 44 posições!", vbCritical, "Erro na entrada de valores"
     'Codificação de código de barras tem obrigatoriamente 44 posições...
     Exit Sub
  End If
  If IsEmpty(CoordX) Then CoordX = 0
  If IsEmpty(CoordY) Then CoordY = 0
  DoEvents
  Barcodes(0) = "00110"         ' 0 indica barra fina e 1 larga
  Barcodes(1) = "10001"
  Barcodes(2) = "01001"
  Barcodes(3) = "11000"
  Barcodes(4) = "00101"
  Barcodes(5) = "10100"
  Barcodes(6) = "01100"
  Barcodes(7) = "00011"
  Barcodes(8) = "10010"
  Barcodes(9) = "01010"
' Agora é desenhar
  'Destino.Cls
  Destino.ScaleMode = 1               ' usa pontos.
  Destino.DrawWidth = 1               ' e traço fino.
' desenha guarda inicial
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
  CoordX = CoordX + Fino
  
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
  CoordX = CoordX + Fino
  
  
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
  CoordX = CoordX + Fino
  
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
  CoordX = CoordX + Fino
' desenha valor
  If Len(Valor) Mod 2 <> 0 Then
    Valor = "0" + Valor
  End If
  Valor = Zeros(Valor, Len(Valor))
  While Len(Valor) > 0
    I = Left$(Valor, 1)
    Valor = Right$(Valor, Len(Valor) - 1)
    j = Left$(Valor, 1)
    Valor = Right$(Valor, Len(Valor) - 1)
    For k = 1 To 5
      If Mid$(Barcodes(I), k, 1) = "0" Then
        Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
        CoordX = CoordX + Fino
      Else
        Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(0), BF
        CoordX = CoordX + Largo
      End If
      DoEvents
      If Mid$(Barcodes(j), k, 1) = "0" Then
        Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
        CoordX = CoordX + Fino
      Else
        Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(15), BF
        CoordX = CoordX + Largo
      End If
    Next
  Wend
' desenha guarda final
  Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(0), BF
  CoordX = CoordX + Largo
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
  CoordX = CoordX + Fino
  Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
  CoordX = CoordX + Fino
End Sub

Private Sub Command1_Click()
    DesenhaBarra "11000290", Picture1, 10, 10
End Sub

T+

Rinaldo