Gerando QR Code com Biblioteca de Terceiro


Option Explicit
'Declarar função para obter pasta temporária (onde poderíamos gravar as imagens de código de barras temporária) 
Declare Function GetTempPath _ 
Lib ‘ kernel32 ’ Alias ‘ GetTempPathA ’ _ 
ByVal nBufferLength As Long, _ 
ByVal lpBuffer As String) As Long
"Função para retornar caminho para a pasta temporária 
Função Pública fncGetTempPath () As String 
   Dim PathLen As Long 
   Dim WinTempDir As String 
   Dim BufferLength As Long 
   Let BufferLength = 260

   
Let WinTempDir = Space ( BufferLength )

   PathLen = GetTempPath ( BufferLength , WinTempDir ) 
   If Not PathLen = 0 Then 
       
Let fncGetTempPath = Esquerda ( WinTempDir , PathLen ) 
   Else 
       
Let fncGetTempPath = CurDir () 
   End If 
End Function
Sub Barcode_Click ()
'Fetch a folha de cálculo 
Dim MySheet A folha de cálculo 
Conjunto MySheet = Folhas de trabalho (1)' Folha Barcode_Data
'temporário caminho para salvar as imagens de código de barras 
Dim filePath As String 
Let filePath = fncGetTempPath ()' Alterar o caminho, mas deve terminar com barra invertida ()
Preparai o Bytescout código de barras Objeto 
'==================================== 
Dim myBarcode As New Bytescout_BarCode.Barcode
myBarcode.RegistrationName = “demo” 'Alterar o nome para a versão completa 
myBarcode.RegistrationKey = ‘demo’' Alterar a chave para a versão completa
'Barcode Configurações de 
código de barras QR myBarcode.Symbology = SymbologyType_QRCode', você pode mudar para outros tipos de código de barras como Code 39, Code 128 etc
'Set código de barras resolução qualidade de imagem Let myBarcode.ResolutionX = 300' resolução superior a 250 é bom para imprimir Let myBarcode.ResolutionY = 300 'resolução superior a 250 é bom para impressão
Let myBarcode.DrawCaption = true 'Mostrando Barcode Legendas no código de barras Imagem 
myBarcode.DrawCaptionFor2DBarcodes = true' Mostrar legendas para códigos de barras 2D como QR Code
'Primeiro limpar a coluna B a partir de imagens antigas (se houver) 
Dim Sh Como Forma 
Com MySheet 
  Para Cada Sh em .Shapes 
      If Not Application.Intersect (Sh.TopLeftCell, .Range ( ‘B1: B50’)) não é nada Então 
        Se Sh .type = msoPicture Então Sh.Delete 
      End If 
   Seguinte Sh 
End With
'Agora gerar novos códigos de barras e de inserir nas células na coluna B 
' Repetir os passos para cada fileira de 2 a 6 
Dim MyVal As Integer

Para MyVal = 2 a 6 'alterar o código para todas as linhas com valores 
   ' analisar o valor a partir da coluna A até Bytescout código de barras objecto 
   myBarcode.Value = mySheet.Cells (MyVal, 1) .Text 
   'Montar o código de barras em 80X30 mm rectângulo 
   myBarcode .FitInto_3 80, 30, 4 '4 refere-se às unidades de medida como milímetro 
   ' Salve a imagem de código de barras para um arquivo na pasta temporária 
   myBarcode.SaveImage filePath & ‘myBarcode’ & MyVal & ‘.png’ 
   
   'Coloque a imagem de código de barras para a coluna B e redimensioná-las para caber na célula. 
   '============================================
   Com mySheet.Pictures.Insert (filePath & “myBarcode” & MyVal & “.png”) 
       .ShapeRange.LockAspectRatio = verdadeiro 'relação de aspecto de bloqueio 
       .Left = mySheet.Cells (MyVal, 2) .Left + 1' conjunto deixado 
       .Top = mySheet.Cells (MyVal, 2) .Top + 1 'direito conjunto 
       .PrintObject = TRUE' permitem imprimir este objecto 
       .Placement = xlMove 'definir o modo de posicionamento de se mover, mas não são redimensionadas com a célula 
       .ShapeRange.ScaleHeight 1, True' escala altura definido para 1 (sem escala) 
       .ShapeRange.ScaleWidth 1, True 'definido escala largura de 1 (sem escala ) 
   End com 

Deixe seus comentários, compartilhe este artigo!


⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

Nenhum comentário:

Postar um comentário

diHITT - Notícias