Boa tarde
Solicito pequena ajuda no Gerador de Etiquetas.
Quando especifica 1 etiqueta, ela é colada nas colunas a,b,c, e quando solicita 2 etiquetas a segunda é colada nas colunas d,e ,f.
O ajuste necessário é quando solicita 3 ou mais etiquetas, a partir da 3º etiqueta as demais etiquetas ficam sobrepostas nas colunas d,e,f.
O que preciso, é que todas as etiquetas fiquem uma abaixo da outra, principalmente quando é solicitado acima de 2 etiquetas.
Segue a macro das etiquetas
Sub Retângulodecantosarredondados1_Clique()
'Sub Gera_Etiqueta()
Application.ScreenUpdating = False
Dim Codigo As String
Dim Lin As Integer
Dim U_L As Integer
Dim I As Integer
Dim Qtde As Integer
Dim Num As String
Dim Cor As String
Dim Loc As String
Dim Nome 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 TESTE As String
Dim TESTE1 As String
Dim TESTE2 As String
Sheets("COD BARRAS").Activate 'GUIA "IMP"
Sheets("COD BARRAS").DrawingObjects.Delete 'GUIA "IMP"
U_L = Sheets("CAD BARRAS").Range("D" & Rows.Count).End(xlUp).Row 'GUIA "GERADOR"
Lin = 1: Col = 1
For I = 2 To U_L
Nome = Sheets("CAD BARRAS").Range("a" & I) 'GUIA "GERADOR"
Num = Sheets("CAD BARRAS").Range("b" & I)
Cor = Sheets("CAD BARRAS").Range("c" & I)
TESTE = Sheets("CAD BARRAS").Range("d" & I)
Qtde = Sheets("CAD BARRAS").Range("e" & I) 'GUIA "GERADOR"
Sheets("RESUMO").Activate 'GUIA "IDENTIFICACAO"
Sheets("resumo").Range("B2") = Nome 'GUIA "IDENTIFICACAO"
With Sheets("resumo").Range("B2")
.Font.FontStyle = "regular"
.Characters(1, InStr(.Value, ":")).Font.Bold = True
End With
Sheets("resumo").Range("A3") = "Fab:" & Num
With Sheets("resumo").Range("a3")
.Font.FontStyle = "regular"
'.Characters(1, InStr(.Value, ":")).Font.Bold = True
End With
Sheets("resumo").Range("a4") = "Val:" & Cor
With Sheets("resumo").Range("a4")
.Font.FontStyle = "regular"
'.Characters(1, InStr(.Value, ":")).Font.Bold = True
End With
Sheets("RESUMO").Range("A5") = "Lote:" & TESTE
With Sheets("resumo").Range("a5")
.Font.FontStyle = "regular"
'.Characters(1, InStr(.Value, ":")).Font.Bold = True
End With
Sheets("resumo").Range("A1:C5").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 + 3
If Col = 6 Then
Lin = Lin + 1
Col = 1 '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 : 29/01/2018 11:56 am