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
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
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 ()
Let fncGetTempPath = CurDir ()
End If
End Function
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
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 ()
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
'====================================
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
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
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
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
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
' 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
' 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!
⬛◼◾▪ CONTATO ▪◾◼⬛
Nenhum comentário:
Postar um comentário