Fóruns
Microsoft Excel - 2...
VBA & Macros
Imprimir e salvar v...
 
Notifications
Clear all

[Resolvido] Imprimir e salvar vários arquivos com nomes de acordo com as células

 
VBA & Macros
Post Recente por Thauan 2 anos atrás
3 Posts
2 Usuários
1 Likes
1,033 Visualizações
RSS
 Thauan
(@thauan)
Posts: 37
Eminent Member
Topic starter
 

fala pessoal bom dia como estão

estou precisando de ajuda com esse código na parte de salvar o arquivo em pdf

Criei essa macro para preencher um layout e imprimir cada linha nesse layout.

Verde - Apesar de da Range está até 1000, ele só preenche até onde tem informação na célula, mas isso é um problema quando vou salvar o pdf porque ele salva 1000 arquivos.

Azul - Aqui eu tentei fazer com que o nome de cada arquivo fosse a informação que estaria da célula a2 e seguinte mas não sem sucesso. ex. arquivo 1 = nome da célula a2, arquivo 2 = nome da célula a3...

 

Sub Imprimirguias()
Dim i As Integer
Dim inss1 As Variant
Dim inss2 As Variant
Dim vlrrat As Variant
Dim cod As Variant
Dim codcc As Variant
Dim descc As Variant
Dim bcalc As Variant
Dim amjur As Variant
Dim patro As Variant
Dim segur As Variant
Dim salfa As Variant
Dim mater As Variant
Dim salvarpdf As String

cod = Application.WorksheetFunction.CountA(Worksheets("DGuias").Range("A2:A1000"))
codcc = Worksheets("DGuias").Range("A2:A1000")
descc = Worksheets("DGuias").Range("B2:B1000")
bcalc = Worksheets("DGuias").Range("C2:C1000")
patro = Worksheets("DGuias").Range("D2:D1000")
vlrat = Worksheets("DGuias").Range("E2:E1000")
segur = Worksheets("DGuias").Range("F2:F1000")
amjur = Worksheets("DGuias").Range("G2:G1000")
salfa = Worksheets("DGuias").Range("H2:H1000")
mater = Worksheets("DGuias").Range("I2:I1000")
inss1 = Worksheets("DGuias").Range("J2:J1000")
inss2 = Worksheets("DGuias").Range("K2:K1000")

For i = 1 To cod
Range("A10") = codcc(i, 1)
Range("A31") = codcc(i, 1)
Range("B10") = descc(i, 1)
Range("B31") = descc(i, 1)
Range("I9") = inss2(i, 1)
Range("I30") = inss2(i, 1)
Range("I10") = vlrat(i, 1)
Range("I31") = vlrat(i, 1)
Range("I13") = amjur(i, 1)
Range("I34") = amjur(i, 1)
Range("I14") = inss1(i, 1)
Range("I35") = inss1(i, 1)
Range("A16") = bcalc(i, 1)
Range("A37") = bcalc(i, 1)
Range("C16") = patro(i, 1)
Range("C37") = patro(i, 1)
Range("E16") = segur(i, 1)
Range("E37") = segur(i, 1)
Range("G16") = salfa(i, 1)
Range("G37") = salfa(i, 1)
Range("I16") = mater(i, 1)
Range("I37") = mater(i, 1)

salvarpdf = "D:\OneDrive\Temporárias\" & i & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=salvarpdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next
End Sub

 
Postado : 14/07/2022 11:13 am
Reinaldo
 Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Algo +/- assim

Sub Imprimirguias()
Dim i As Integer, Cod As Integer
Dim salvarpdf As String

Cod = Application.WorksheetFunction.CountA(Worksheets("DGuias").Range("A2:A1000"))

For i = 1 To Cod
Range("A10") = Sheets("DGuias").Cells(i, 1) 'Coluna "A"'codcc(i, 1)
Range("A31") = Sheets("DGuias").Cells(i, 1) 'Coluna "A"'codcc(i, 1)
Range("B10") = Sheets("DGuias").Cells(i, 2) 'Coluna "B"'descc(i, 1)
Range("B31") = Sheets("DGuias").Cells(i, 2) 'Coluna "B"'descc(i, 1)
Range("I9") = Sheets("DGuias").Cells(i, 10) 'Coluna "J"'inss2(i, 1)
Range("I30") = Sheets("DGuias").Cells(i, 11) 'Coluna "K"'inss2(i, 1)
Range("I10") = Sheets("DGuias").Cells(i, 5) 'Coluna "E"'vlrat(i, 1)
Range("I31") = Sheets("DGuias").Cells(i, 5) 'Coluna "E"'vlrat(i, 1)
Range("I13") = Sheets("DGuias").Cells(i, 7) 'Coluna "G"'amjur(i, 1)
Range("I34") = Sheets("DGuias").Cells(i, 7) 'Coluna "G"'amjur(i, 1)
Range("I14") = Sheets("DGuias").Cells(i, 10) 'Coluna "J"'inss1(i, 1)
Range("I35") = Sheets("DGuias").Cells(i, 10) 'Coluna "J"'inss1(i, 1)
Range("A16") = Sheets("DGuias").Cells(i, 3) 'Coluna "C"'bcalc(i, 1)
Range("A37") = Sheets("DGuias").Cells(i, 3) 'Coluna "C"'bcalc(i, 1)
Range("C16") = Sheets("DGuias").Cells(i, 4) 'Coluna "D"'patro(i, 1)
Range("C37") = Sheets("DGuias").Cells(i, 4) 'Coluna "D"'patro(i, 1)
Range("E16") = Sheets("DGuias").Cells(i, 6) 'Coluna "F"'segur(i, 1)
Range("E37") = Sheets("DGuias").Cells(i, 6) 'Coluna "F"'segur(i, 1)
Range("G16") = Sheets("DGuias").Cells(i, 8) 'Coluna "H"'salfa(i, 1)
Range("G37") = Sheets("DGuias").Cells(i, 8) 'Coluna "H"'salfa(i, 1)
Range("I16") = Sheets("DGuias").Cells(i, 9) 'Coluna "I"'mater(i, 1)
Range("I37") = Sheets("DGuias").Cells(i, 9) 'Coluna "I"'mater(i, 1)

'Atribui o caminho e nome para o pdf ; nome refere-se a coluna B linha variavel com i;
salvarpdf = "D:\OneDrive\Temporárias\" & Sheets("DGuias").Cells(i, 2).Value & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=salvarpdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next
End Sub

Reinaldo

 
Postado : 22/07/2022 3:29 pm
Thauan reacted
 Thauan
(@thauan)
Posts: 37
Eminent Member
Topic starter
 

@rlm SHOW!
serviu perfeitamente, fiz uma modificação pois estava salvando um arquivo com nome de outro e adicionei mais uma coisinha
" & Sheets("DGuias").Cells(i + 1, 1).Value & " - " & Sheets("DGuias").Cells(i + 1, 2).Value & ".pdf"

 
Postado : 29/07/2022 2:37 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico