Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Imprimir varias fol...
 
Notifications
Clear all

Imprimir varias folhas excel para um unico Pdf

 
2024 - VBA & Macros
15 Posts
2 Usuários
0 Reactions
2,570 Visualizações
RSS
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

[Boa Tarde,

Estou com dificuldade para encontrar uma solução para o meu problema que é o seguinte:

Eu tenho em excel varias folhas de calculo e precisava de actualizar a minha macro para imprimir as folhas que são seleccionadas automaticamente, num unico ficheiro pdf,
em que ele ficasse com o nome definido numa celula.

se alguém me pudesse ajudar agradecia.

Sub Macro9()
 If MsgBox(("Tem a certeza que deseja imprimir a AMOSTRA COMPLETA ?"), vbYesNo + vbQuestion, "CONFIRMAÇÃO") = vbYes Then
    If Range("AB21") = ("X") Then
   Sheets("baridade inertes").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB27") = ("X") Then
   Sheets("fragmentabilidade").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB28") = ("X") Then
   Sheets("degradabilidade").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
    If Range("AB16") = ("X") Then
   Sheets("índice lam.-alon.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB17") = ("X") Then
   Sheets("L.Ang.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB14") = ("X") Then
   Sheets("Mat.Org.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB13") = ("X") Then
   Sheets("Teor hum.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB11") = ("X") Then
   Sheets("CBR4").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("CBR3").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("CBR2").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Sheets("CBR1").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Sheets("Menu").Select
    End If
   If Range("AB25") = ("X") Then
   Sheets("CBR Instantaneo").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB25") = ("X") Then
   Sheets("Grafico CBR Ins.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB22") = ("X") Then
   Sheets("Estudo T.V.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB26") = ("X") Then
   Sheets("Macro").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   
   If Range("AB12") = ("X") Then
   Sheets("P.Esp.solos (grãos)").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB7") = ("X") Then
   If Range("AB10") = ("X") Then
   If Range("AB18") = ("X") Then
   Sheets("Corrc. > 19 mm").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   End If
   End If
   If Range("AB7") = ("X") Then
   If Range("AB18") = ("X") Then
   If Range("AB19") = ("X") Then
   If Range("AB20") = ("X") Then
   Sheets("P.Esp.(M.P.)> 19mm").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   End If
   End If
   End If
   If Range("AB20") = ("X") Then
   Sheets("P.Esp. <4,76mm").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB19") = ("X") Then
   Sheets("P.Esp. >4,76mm").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB18") = ("X") Then
   Sheets("P.Esp >19mm").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB10") = ("X") Then
   Sheets("Proctor").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB15") = ("X") Then
   Sheets("azul met.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB8") = ("X") Then
   Sheets("E. Areia").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB7") = ("X") Then
   Sheets("Granulometria").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB9") = ("X") Then
   Sheets("Lim.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB9") = ("X") Then
   If Range("AB7") = ("X") Then
   Sheets("Classif.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   End If
   If Range("AB6") = ("X") Then
   Sheets("R. Am.").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   If Range("AB5") = ("X") Then
   Sheets("Proc").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   End If
   Sheets("RA").Select
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   Sheets("Menu").Select
   If MsgBox(("A imprimir a Amostra Completa"), vbOKOnly + vbInformation, "INFORMAÇÃO") = vbOK Then
   End If
   End If
 End Sub
 
Postado : 29/09/2012 2:47 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Qual o seu excel? Qual a sua afinidade com VBA?
Para 2003 deve-se utilizar um criador de pdf (daqueles que criam uma impressora virtual em seu micro.
Vendo o seguinte tópico no excel guru http://www.excelguru.ca/content.php?161; creio que para imprimir no 2007 e acima multiplas paginas tambem

 
Postado : 29/09/2012 5:27 pm
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

Boa Tarde,
O excel é o 2010 e a minha afinidade com VBA é quase nenhuma, é mais do desenrasque.

Mas o meu problema é que as folhas a ser imprimidas não são sempre as mesmas. e naõ são as folhas que estão na folha do botão para imprimir.

Obrigado

 
Postado : 30/09/2012 8:48 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

E como define quais serão impressas?

 
Postado : 30/09/2012 9:40 am
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

É o excel que escolhe de uma tabela.

O que eu tenho, ele vai procurar nas celulas e as que tiverem X ele manda imprmir, e eu queria ver se conseguia imprimir para um só pdf e ao mesmo tempo meter o nome e guardar num sitio especifico.

 
Postado : 30/09/2012 10:16 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aparentemente somente é possivel com um gerador de pdf externo (assim como pdf Creator), vc tem algum instalado? Pode instalar se for preciso?
Tem como dispor de um modelo significativo de sua planilha com valores e dados ficticios; informar como espera definir o nome e local para salvar?
Assim podemos tentar montar algo que lhe atenda.

 
Postado : 30/09/2012 1:22 pm
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

Envio já muito obrigado

O ficheiro tem mais macros mas só envio a que uso para imprimir, que se refere ao botão imprimir amostra.

O nome do ficheiro e o caminho é inserido automaticamente numa celula de uma folha.

Menu teste.rar
 
Postado : 30/09/2012 1:28 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Veja se lhe auxilia:
Percorre as linhas AB5 ate AB45 e identifica onde tem "X", então guarda o nome da planilha que coloquei em AD

Sub CriaPDF()
   'Versoes 2007 e acima
    Dim SvInput As String, myArr As Integer, Rng As Integer, nP As String
Dim MyArray() As Variant
Sheets("Menu").Select
myArr = 0
Rng = 45
For x = 5 To Rng
    If Cells(x, 28).Value = "X" Then
    ReDim Preserve MyArray(NbPlan)
    nP = Cells(x, 30)
    MyArray(NbPlan) = nP
    NbPlan = NbPlan + 1
    End If
Next
    SvInput = "C:TempPROGR_PR" & "_" & Format(Date - 1, "dd-mm-yyyy") & ".pdf"
    Sheets(MyArray).Select
If SvInput <> "False" Then
    ActiveSheet.ExportAsFixedFormat xlTypePDF, SvInput, xlQualityStandard
Else
    MsgBox "Diretorio para salvar, não encontrado"
End If
Sheets("Menu").Select
End Sub
 
Postado : 01/10/2012 1:03 pm
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

boa tarde e muito obrigado pela solução que enviaste.
uma parte já está, ele já me selecciona as folhas que quero imprimir sõ que não imprime.

Cumprimentos

 
Postado : 02/10/2012 11:24 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Well.
Imprimir para PDF, na realidade significa "salvar/exportar" um determinado dado para um formato PDF, montando assim um arquivo com esses dados com extensão pdf.
E o que o codigo que lhe passei faz (pelo menos nos teste que fiz); Cria um arquivo em formato PDF no diretorio "C:Temp" com o nome "PROGR_PR_01-10-2012.pdf", onde a data altera de acordo com o dia. Se não localizar o diretoriodeveria dar a mensagem "Diretorio para salvar, não encontrado".
Não esta a faze isso?? Não retorna a mensagem??

 
Postado : 02/10/2012 11:56 am
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

Está a funcionar muitissimo obrigado, agora só preciso de o por a mudar o nome do ficheiro consoante o numero da amostra.

 
Postado : 02/10/2012 2:16 pm
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

Quando passo para a folha principal diz que o Sheets(MyArray).Select script out of range

 
Postado : 02/10/2012 3:45 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não entendi? O que foi feito?

 
Postado : 03/10/2012 6:15 am
 Proa
(@proa)
Posts: 8
Active Member
Topic starter
 

A unica coisa que fiz foi meter a macro no livro original, que tem mais folhas.
mas o formato do menu e as colunas e linhas é a mesma coisa o que muda é as outras folhas

 
Postado : 03/10/2012 11:06 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Pois é, então deve ser por causa dos nomes das planilhas.
A macro "olha os "X" na coluna 28 ("AB") e os nomes das planilhas na coluna 30 ("AD") sendo que a coluna 29 ("AC") e para uma descrição mais generica das suas planilhas.
Exemplo: em AC5 tem a descrição: "Processo", porem no arquivo tem a planilha "PROC"
Então vc precisa garantir que na coluna 30 tenha os nomes corretos das planilhas. Caso queira utilizar a mesma atual, altere na macro de: nP = Cells(x, 30) para: nP = Cells(x, 29); mas as descrições devem ser iguais as das planilhas.

 
Postado : 03/10/2012 12:45 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico