Notifications
Clear all

Gerador de etiquetas

2 Posts
1 Usuários
0 Reactions
1,159 Visualizações
(@souzadenilson)
Posts: 96
Estimable Member
Topic starter
 

Boa noite.
Foi feita algumas alterações em um gerador de planilha, porem alguns dados ficarão na mesma linha.
Preciso que a palavra "CÓDIGO:" e "Nº DO CQ:" e "FABRICAÇÃO:" e "VALIDADE:" que ficarão na mesma linha somente ficarão negrito.
Estas informações que irão ficar na mesma linha exista um espaço entre elas

Devido arquivo ser muito grande segue código fonte.
Existe um arquivo semelhante em um post de alguns meses atrás.


Sub Ret?ngulodecantosarredondados1_Clique()
'Sub Gera_Etiqueta()


Application.ScreenUpdating = False

Dim MateriaPrima As String
Dim Lin As Integer
Dim U_L As Integer
Dim I As Integer
Dim Qtde As Integer
Dim Fornecedor As String
Dim DataRecebimento As String
Dim LoteFornecedor As String
Dim LoteFabricante As String
Dim CodigoProduto As String
Dim S As String ' sitema de corte
Dim Cod_Rastreio As String
Dim Col As Integer
Dim ik As Integer
Dim Receb As Date
Dim LOTE As Integer
Dim NCQ As String
Dim Fabricacao As String
Dim Validade As String
Sheets("COD BARRAS").Activate 'GUIA "IMP"
    
    Sheets("COD BARRAS").DrawingObjects.Delete 'GUIA "IMP"
    U_L = Sheets("CAD BARRAS").Range("A" & Rows.Count).End(xlUp).Row 'GUIA "GERADOR"
    Lin = 1: Col = 1
    
    For I = 2 To U_L
        MateriaPrima = Sheets("CAD BARRAS").Range("B" & I) 'GUIA "GERADOR"
        
        CodigoProduto = Sheets("CAD BARRAS").Range("C" & I)
        Fornecedor = Sheets("CAD BARRAS").Range("D" & I)
        DataRecebimento = Sheets("CAD BARRAS").Range("E" & I)
        NCQ = Sheets("CAD BARRAS").Range("A" & I)
        Fabricacao = Sheets("CAD BARRAS").Range("f" & I)
        Validade = Sheets("CAD BARRAS").Range("G" & I)
        LoteFornecedor = Sheets("CAD BARRAS").Range("h" & I)
        LoteFabricante = Sheets("CAD BARRAS").Range("I" & I)
        
        Qtde = Sheets("CAD BARRAS").Range("J" & I)  'GUIA "GERADOR"
        'S = Sheets("REFERENCIA").Range("H" & I) 'sistema de corte
        'Cod_Rastreio = Sheets("REFERENCIA").Range("I" & I) 'c?d. rastreio
        
        
        Sheets("RESUMO").Activate               'GUIA "IDENTIFICACAO"
        Sheets("resumo").Range("A2") = "MATERIA-PRIMA:" & MateriaPrima  'GUIA "IDENTIFICACAO"
        With Sheets("resumo").Range("a2")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("A3") = "DATA DE RECEBIMENTO:" & DataRecebimento
        With Sheets("resumo").Range("a3")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("a4") = "C?DIGO:" & CodigoProduto & "  " & "N? DO CQ:" & NCQ
        With Sheets("resumo").Range("a4")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
           '.Characters(1, InStr(.Value, "N? DO CQ:")).Font.Bold = True
        End With
        'Sheets("resumo").Range("B4") = "N? DO CQ:" & NCQ
        'With Sheets("resumo").Range("B4")
           '.Font.FontStyle = "regular"
           '.Characters(1, InStr(.Value, ":")).Font.Bold = True
        'End With
        Sheets("RESUMO").Range("A5") = "FORNECEDOR:" & Fornecedor
        With Sheets("resumo").Range("a5")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A6") = "LOTE DO FORNECEDOR:" & LoteFornecedor
        With Sheets("resumo").Range("a6")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A7") = "LOTE DO FORNECEDOR:" & LoteFabricante 'sistema de corte
        With Sheets("resumo").Range("a7")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A8") = "FABRICA??O:" & Fabricacao & "VALIDADE:" & Validade 'sistema de corte
        With Sheets("resumo").Range("a8")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("B8") = "VALIDADE:" & Validade 'sistema de corte
        With Sheets("resumo").Range("B8")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("A1:a8").Copy    'GUIA "IDENTIFICACAO"
    
        Sheets("COD BARRAS").Activate                'GUIA "IMP"
        
        For ik = 1 To Qtde
        
       Sheets("COD BARRAS").Cells(Lin, Col).Select   'GUIA "IMP"
      ' Sheets("COD BARRAS").Cells(Lin, Col).Select        'GUIA "IMP"
       Sheets("COD BARRAS").Pictures.Paste              'GUIA "IMP"
            
            Col = Col + 1
            If Col = 3 Then
                Lin = Lin + 1
                Col = 1
            End If
        Next ik
    Next I
    
    
'    For ik = 1 To Qtde
'
'       Sheets("COPIAS QUADROS").Cells(Lin, COL).Select     'GUIA "IMP"
'       'Sheets("COPIAS QUADROS").Cells(Lin, COL).Select        'GUIA "IMP"
'       Sheets("COPIAS QUADROS").Pictures.Paste              'GUIA "IMP"
'
'            COL = COL + 1
'            If COL = 4 Then
'                Lin = Lin + 1
'                COL = 1
'            End If
'        Next
'    Next
    
    
    
    
    
    
  Unload UserForm1
  
Application.ScreenUpdating = True

ActiveWindow.SelectedSheets.PrintPreview
'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
'Sheets("CAD BARRAS").Select
'End Sub
End Sub
 
Postado : 24/07/2018 7:39 pm
(@souzadenilson)
Posts: 96
Estimable Member
Topic starter
 

Boa noite. o problema em questão que não estou conseguindo deixar em negrito duas informações que se encontram na mesma linha., conforme foto em anexo.
As demais informações que desejo e foi programado para macro, está funcionando perfeitamente.
Tentei mesclar duas células "A:B", e onde tem duas informações na mesma linha uma ficou na coluna a e a outra na b, então funcionou perfeitamente, porem quando gero mais de uma etiqueta, a mesma fica sobreposta. e a intenção é deixa-las uma ao lado da outra, e se necessário preencher a folha, no case seria as etiquetas em duas colunas.
Foto como deverá ficar a etiqueta está em anexo.


Sub Ret?ngulodecantosarredondados1_Clique()
'Sub Gera_Etiqueta()


Application.ScreenUpdating = False

Dim MateriaPrima As String
Dim Lin As Integer
Dim U_L As Integer
Dim I As Integer
Dim Qtde As Integer
Dim Fornecedor As String
Dim DataRecebimento As String
Dim LoteFornecedor As String
Dim LoteFabricante As String
Dim CodigoProduto As String
Dim S As String ' sitema de corte
Dim Cod_Rastreio As String
Dim Col As Integer
Dim ik As Integer
Dim Receb As Date
Dim LOTE As Integer
Dim NCQ As String
Dim Fabricacao As String
Dim Validade As String
Sheets("COD BARRAS").Activate 'GUIA "IMP"
    
    Sheets("COD BARRAS").DrawingObjects.Delete 'GUIA "IMP"
    U_L = Sheets("CAD BARRAS").Range("A" & Rows.Count).End(xlUp).Row 'GUIA "GERADOR"
    Lin = 1: Col = 1
    
    For I = 2 To U_L
        MateriaPrima = Sheets("CAD BARRAS").Range("B" & I) 'GUIA "GERADOR"
        CodigoProduto = Sheets("CAD BARRAS").Range("C" & I)
        Fornecedor = Sheets("CAD BARRAS").Range("D" & I)
        DataRecebimento = Sheets("CAD BARRAS").Range("E" & I)
        NCQ = Sheets("CAD BARRAS").Range("A" & I)
        Fabricacao = Sheets("CAD BARRAS").Range("f" & I)
        Validade = Sheets("CAD BARRAS").Range("G" & I)
        LoteFornecedor = Sheets("CAD BARRAS").Range("h" & I)
        LoteFabricante = Sheets("CAD BARRAS").Range("I" & I)
        
        Qtde = Sheets("CAD BARRAS").Range("J" & I)  'GUIA "GERADOR"
        'S = Sheets("REFERENCIA").Range("H" & I) 'sistema de corte
        'Cod_Rastreio = Sheets("REFERENCIA").Range("I" & I) 'c?d. rastreio
        
        
        Sheets("RESUMO").Activate               'GUIA "IDENTIFICACAO"
        Sheets("resumo").Range("A2") = "MATERIA-PRIMA:" & MateriaPrima  'GUIA "IDENTIFICACAO"
        With Sheets("resumo").Range("a2")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("A3") = "DATA DE RECEBIMENTO:" & DataRecebimento
        With Sheets("resumo").Range("a3")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("a4") = "C?DIGO:" & CodigoProduto '& "                " & "N? DO CQ:" & NCQ
        With Sheets("resumo").Range("a4")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
           
        End With
        Sheets("resumo").Range("B4") = "N? DO CQ:" & NCQ
        With Sheets("resumo").Range("a4")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A5") = "FORNECEDOR:" & Fornecedor
        With Sheets("resumo").Range("a5")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A6") = "LOTE DO FORNECEDOR:" & LoteFornecedor
        With Sheets("resumo").Range("a6")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A7") = "LOTE DO FORNECEDOR:" & LoteFabricante 'sistema de corte
        With Sheets("resumo").Range("a7")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("RESUMO").Range("A8") = "FABRICA??O:" & Fabricacao '& "    " & "VALIDADE:" & Validade 'sistema de corte
        With Sheets("resumo").Range("a8")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
          
        End With
        Sheets("RESUMO").Range("a8") = "VALIDADE:" & Validade 'sistema de corte
        With Sheets("resumo").Range("B8")
           .Font.FontStyle = "regular"
           .Characters(1, InStr(.Value, ":")).Font.Bold = True
        End With
        Sheets("resumo").Range("A1:b8").Copy    'GUIA "IDENTIFICACAO"
    
        Sheets("COD BARRAS").Activate                'GUIA "IMP"
        
        For ik = 1 To Qtde
        
       Sheets("COD BARRAS").Cells(Lin, Col).Select   'GUIA "IMP"
      ' Sheets("COD BARRAS").Cells(Lin, Col).Select        'GUIA "IMP"
       Sheets("COD BARRAS").Pictures.Paste              'GUIA "IMP"
            
            Col = Col + 1
            If Col = 3 Then
                Lin = Lin + 1
                Col = 1
            End If
        Next ik
    Next I
    
    
'    For ik = 1 To Qtde
'
'       Sheets("COPIAS QUADROS").Cells(Lin, COL).Select     'GUIA "IMP"
'       'Sheets("COPIAS QUADROS").Cells(Lin, COL).Select        'GUIA "IMP"
'       Sheets("COPIAS QUADROS").Pictures.Paste              'GUIA "IMP"
'
'            COL = COL + 1
'            If COL = 4 Then
'                Lin = Lin + 1
'                COL = 1
'            End If
'        Next
'    Next
    
    
    
    
    
    
  'Unload UserForm1
  
Application.ScreenUpdating = True

ActiveWindow.SelectedSheets.PrintPreview
'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
'Sheets("CAD BARRAS").Select
'End Sub
End Sub
 
Postado : 25/07/2018 9:58 pm