Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
salvar em pdf duas ...
 
Notifications
Clear all

salvar em pdf duas áreas de impressão

 
2024 - VBA & Macros
Post Recente por Gilbertob 8 anos atrás
15 Posts
3 Usuários
0 Reactions
2,231 Visualizações
RSS
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Boa noite,

Na planilha anexa, tenho a aba "Verbas", com colunas de A:AJ. Gostaria do auxílio dos colegas, para tentar criar uma macro que salvasse em PDF o intervalo A6:R27 e, em outra página o intervalo A6:AJ28, mas ocultando as colunas F até R. Tentei fazer usando o gravador de macros, mas o resultado não foi o esperado. 

Sub imprimir_verbas()
'
' imprimir_verbas Macro
'
' Atalho do teclado: Ctrl+e

    With ActiveSheet.PageSetup
    
    .CenterHeader = "RESUMO DAS VERBAS RESCISÓRIAS"
    .CenterHorizontally = True
    .Orientation = xlLandscape
    .FitToPagesTall = False
    .FitToPagesWide = 2
    .Zoom = False
    
    End With

'
    Range("A6:R21").Select
    ActiveSheet.PageSetup.PrintArea = "$A$6:$R$21"
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "G:Planilhas da MóvelTRCT v6.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
        OpenAfterPublish:=True
    
    Columns("F:R").Select
    Selection.EntireColumn.Hidden = True
    Range("A6:AJ41").Select
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "G:Planilhas da MóvelTRCT v7.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
        OpenAfterPublish:=True
        
      Selection.EntireColumn.Hidden = False
        
End Sub

Atenciosamente,

Gilberto

 
Postado : 08/01/2017 9:55 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia Gilbertob,

Tenta assim:

Option Explicit

Sub imprimir_verbas()
Dim wsVerbas    As Worksheet
Dim Caminho     As String

' imprimir_verbas Macro
' Atalho do teclado: Ctrl+e

    Set wsVerbas = ThisWorkbook.Worksheets("Verbas")
    Caminho = "G:Planilhas da Móvel"
    
    With wsVerbas.PageSetup
        .CenterHeader = "RESUMO DAS VERBAS RESCISÓRIAS"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .FitToPagesTall = False
        .FitToPagesWide = 2
        .Zoom = False
    End With

    wsVerbas.PageSetup.PrintArea = "A6:R21"
    wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True
   
    wsVerbas.Columns("F:R").EntireColumn.Hidden = True
   
    wsVerbas.PageSetup.PrintArea = "A6:AJ41"
    wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True
       
    wsVerbas.Range("A6:AJ41").EntireColumn.Hidden = False
    
    Set wsVerbas = Nothing
    
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/01/2017 6:56 am
gfranco
 gfranco
(@wzxnet7)
Posts: 653
Honorable Member
 

Bom dia Gilberto.
Veja se o que fiz lhe ajuda.

Resposta útil? Clique na mãozinha ao lado do botão Citar.

 
Postado : 09/01/2017 7:10 am
gfranco
 gfranco
(@wzxnet7)
Posts: 653
Honorable Member
 

Peço desculpas ao amigo Bernardo pois, como estava com a janela aberta, não observei que ele já havia respondido à questão.

Resposta útil? Clique na mãozinha ao lado do botão Citar.

 
Postado : 09/01/2017 7:12 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Peço desculpas ao amigo Bernardo pois, como estava com a janela aberta, não observei que ele já havia respondido à questão.

Sem problemas...
Sugestões e ajudas nunca são demais...
Tamo junto.

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/01/2017 7:15 am
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Bom dia Bernardo,

Obrigado pela ajuda. A macro funcionou. Gostaria, se possível, de duas alterações:

1 - Do jeito que está, ela está gerando dois arquivos. Seria possível termos um só arquivo, com cada seleção em um única página?

2 - Ao gravar a macro, eu estava usando a planilha que estava salva na pasta Planilhas da Móvel, dentro de um pendrive, daí o Caminho = "G:Planilhas da Móvel".

Como ela deverá ser usada por mais pessoas, tem como adaptar a macro para que ela seja salva em qualquer pasta a escolha do usuário?

Um grande abraço,

Gilberto

 
Postado : 09/01/2017 7:45 am
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Bom dia Wzxnet7

Só agora vi a tua resposta. Obrigado pelo auxílio. Como estava tentando criar a macro por meio do gravador de macro, intuitivamente eu salvei a primeira seleção e fui em exportar para pdf, fazendo a mesma coisa com a segunda seleção, mas o que eu gostaria mesmo, conforme expliquei na resposta para o Bernardo, é de um único arquivo, com cada seleção em uma página, que o arquivo gerado pudesse ser salvo em qualquer pasta a escolha do usuário e que quando o processamento terminasse o arquivo fosse visualizado.

Um grande abraço.

 
Postado : 09/01/2017 8:08 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Estranho que aqui está criando apenas um arquivo.
Mas tenta assim:

Option Explicit

Sub imprimir_verbas()
Dim wsVerbas    As Worksheet
Dim Caminho     As String

' imprimir_verbas Macro
' Atalho do teclado: Ctrl+e

    Set wsVerbas = ThisWorkbook.Worksheets("Verbas")
    Caminho = SelectFolder & ""
    
    If Len(Caminho) < 3 Or Dir(Caminho, vbDirectory) = "" Then
        MsgBox "Caminho não selecionado"
        Exit Sub
    End If
    
    With wsVerbas.PageSetup
        .CenterHeader = "RESUMO DAS VERBAS RESCISÓRIAS"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .FitToPagesTall = False
        .FitToPagesWide = 2
        .Zoom = False
    End With

    wsVerbas.PageSetup.PrintArea = "A6:R21"
    wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _
        From:=1, To:=1
   
    wsVerbas.Columns("F:R").EntireColumn.Hidden = True
   
    wsVerbas.PageSetup.PrintArea = "A6:AJ41"
    wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, From:=1, To:=2, OpenAfterPublish:=True
       
    wsVerbas.Range("A6:AJ41").EntireColumn.Hidden = False
   
    Set wsVerbas = Nothing
   
End Sub

Public Function SelectFolder() As String
Dim fileDialog  As fileDialog

    Set fileDialog = Excel.Application.fileDialog(msoFileDialogFolderPicker)
    
    fileDialog.Title = "Selecione a Pasta"
    If fileDialog.Show = True Then
        DoEvents
        SelectFolder = fileDialog.SelectedItems(1)
    End If

    Set fileDialog = Nothing

End Function

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/01/2017 8:41 am
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Oi Bernardo,

Talvez eu não esteja conseguindo transmitir o que preciso. Ao executar este último código, foi gerado um único arquivo com o nome TRCT v.6 contendo as colunas A até AJ, com as colunas "'F:R" ocultas. A outra seleção A:R não foi salva.

Vi que precisava mudar o nome dos arquivos.

wsVerbas.PageSetup.PrintArea = "A6:R21"
wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _ '(troquei "TRCT v6 por TRCT v5.pdf)
From:=1, To:=1

wsVerbas.Columns("F:R").EntireColumn.Hidden = True

wsVerbas.PageSetup.PrintArea = "A6:AJ41"
wsVerbas.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Caminho & "TRCT v6.pdf", Quality:=xlQualityStandard, _ '(troquei TRCT v6 por TRCT v7.pdf)
IncludeDocProperties:=True, From:=1, To:=2, OpenAfterPublish:=True

Daí o código gerou os arquivos TRCT v5 e TRCT v7. O que eu gostaria é que gerasse um único arquivo com duas páginas. Na primeira página, a seleção A:R e, na segunda, a seleção A:AJ, mas ocultando F:R.

Um grande abraço.

 
Postado : 09/01/2017 11:13 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 
Option Explicit

Sub imprimir_verbas()
Dim wsVerbas1   As Worksheet
Dim wsVerbas2   As Worksheet
Dim caminho     As String

' imprimir_verbas Macro
' Atalho do teclado: Ctrl+e

    Application.ScreenUpdating = False
    
    Sheets("Verbas").Select
    Sheets("Verbas").Copy After:=Sheets(Sheets.Count)
    
    Set wsVerbas1 = ThisWorkbook.Worksheets("Verbas")
    Set wsVerbas2 = ThisWorkbook.Worksheets(Sheets.Count)
    caminho = SelectFolder & ""

    
    If Len(caminho) < 3 Or Dir(caminho, vbDirectory) = "" Then
        MsgBox "Caminho não selecionado"
        Exit Sub
    End If
   
    Call ConfPagina(wsVerbas1.Name)
    Call ConfPagina(wsVerbas2.Name)
    
    wsVerbas1.PageSetup.PrintArea = "A6:R21"
    wsVerbas2.PageSetup.PrintArea = "A6:AJ41"
    
    wsVerbas1.Columns("F:R").EntireColumn.Hidden = True
    wsVerbas2.Columns("F:R").EntireColumn.Hidden = True
    
    
    Call SavePDF(wsVerbas1.Name, wsVerbas2.Name, caminho)
         
    wsVerbas1.Range("A6:AJ41").EntireColumn.Hidden = False
   
    Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True
    
    wsVerbas1.Activate
   
    Set wsVerbas1 = Nothing
    Set wsVerbas2 = Nothing
    Application.ScreenUpdating = True
   
End Sub

Public Sub SavePDF(ByVal ws As String, ByVal ws2 As String, ByVal caminho As String)

    Sheets(Array(ws, ws2)).Select
    ActiveSheet.ExportAsFixedFormat _
             Type:=xlTypePDF, _
             Filename:=caminho & "TRCT v6.pdf", _
             Quality:=xlQualityStandard, _
             IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, _
             OpenAfterPublish:=True
End Sub

Public Sub ConfPagina(ByVal ws As String)
    With ThisWorkbook.Worksheets(ws).PageSetup
        .CenterHeader = "RESUMO DAS VERBAS RESCISÓRIAS"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .FitToPagesTall = False
        .FitToPagesWide = 2
        .Zoom = False
    End With
End Sub



Public Function SelectFolder() As String
Dim fileDialog  As fileDialog

    Set fileDialog = Excel.Application.fileDialog(msoFileDialogFolderPicker)
   
    fileDialog.Title = "Selecione a Pasta"
    If fileDialog.Show = True Then
        DoEvents
        SelectFolder = fileDialog.SelectedItems(1)
    End If

    Set fileDialog = Nothing

End Function

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/01/2017 1:51 pm
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Olá Bernardo,

Testei o último código. Como estava sendo criado um arquivo com várias páginas, mudei

.FitToPagesTall = False
.FitToPagesWide =
.Zoom = False

Para:

.FitToPagesTall = 1
.FitToPagesWide = 1
.Zoom = False

Daí o número de páginas ficou ok, mas a primeira seleção estava aparecendo somente as colunas A:E.
Troquei wsVerbas1.Columns("F:R").EntireColumn.Hidden = True por wsVerbas1.Columns("F:R").EntireColumn.Hidden = False, e agora está como eu queria que ficasse.

Talvez o meu problema tenha sido não ter explicado direito desde o começo o que eu queria. Como a planilha "Verbas" tem muitas colunas (de A até AJ), e ficaria pequeno enfiar todas elas em uma única página, pensei em criar um resumo que, primeiro exibisse as colunas A até R, e, numa segunda página, exibisse o restante das colunas (de S até AJ) porém repetindo as cinco primeiras colunas (que são as colunas que identificam o trabalhador e contém as informações básicas).

Um forte abraço,

Gilberto.

 
Postado : 09/01/2017 3:18 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Faz parte.

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/01/2017 4:11 pm
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Boa noite Bernardo,

Considerando que a planilha será usada por diferentes usuários em n situações (empresas) tem como alterar o código para que, ao invés da instrução abaixo, fique por conta do usuário escolher o nome do arquivo que será salvo?

Filename:=caminho & "TRCT v1.pdf", _

Abraços,

Gilberto

 
Postado : 09/01/2017 9:22 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Vê se ajuda:

Option Explicit

Sub imprimir_verbas()
Dim wsVerbas1   As Worksheet
Dim wsVerbas2   As Worksheet
Dim Caminho     As String
Dim NomePDF     As String
Dim Abrir       As String

' imprimir_verbas Macro
' Atalho do teclado: Ctrl+e

    Application.ScreenUpdating = False
    
    Caminho = SelectFolder & ""
    If Len(Caminho) < 3 Or Dir(Caminho, vbDirectory) = "" Then
        MsgBox "Caminho não selecionado"
        Exit Sub
    End If
    
    NomePDF = Application.InputBox("Digite o nome do arquivo a ser salvo", "Nome", "TRCT v6", 0.5, 0.5, Type:=2)
    If NomePDF = "Falso" Then
        MsgBox "Nome não definido"
        Exit Sub
    End If
    
    Sheets("Verbas").Select
    Sheets("Verbas").Copy After:=Sheets(Sheets.Count)
    
    Set wsVerbas1 = ThisWorkbook.Worksheets("Verbas")
    Set wsVerbas2 = ThisWorkbook.Worksheets(Sheets.Count)
    
    Call ConfPagina(wsVerbas1.Name)
    Call ConfPagina(wsVerbas2.Name)
    
    wsVerbas1.PageSetup.PrintArea = "A6:R21"
    wsVerbas2.PageSetup.PrintArea = "A6:AJ41"
    
    wsVerbas1.Columns("F:R").EntireColumn.Hidden = True
    wsVerbas2.Columns("F:R").EntireColumn.Hidden = True
    
    
    Call SavePDF(wsVerbas1.Name, wsVerbas2.Name, Caminho, NomePDF)
         
    wsVerbas1.Range("A6:AJ41").EntireColumn.Hidden = False
   
    Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True
    
    wsVerbas1.Activate
    
    Abrir = MsgBox("Arquivo salvo com sucesso!" & vbNewLine & vbNewLine & _
           "Nome do arquivo: " & NomePDF & vbNewLine & _
           "Local: " & Caminho & vbNewLine & vbNewLine & _
           "Pressione 'Ok' para abrir o arquivo salvo ou 'cancelar' para fechar.", _
           vbOKCancel)
    
    If Abrir = "1" Then ThisWorkbook.FollowHyperlink Caminho & NomePDF & ".pdf"
    
    Set wsVerbas1 = Nothing
    Set wsVerbas2 = Nothing
    Application.ScreenUpdating = True
   
End Sub

Public Sub SavePDF(ByVal ws As String, _
                   ByVal ws2 As String, _
                   ByVal Caminho As String, _
                   ByVal NomePDF As String)

    Sheets(Array(ws, ws2)).Select
    ActiveSheet.ExportAsFixedFormat _
             Type:=xlTypePDF, _
             Filename:=Caminho & NomePDF & ".pdf", _
             Quality:=xlQualityStandard, _
             IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, _
             OpenAfterPublish:=False
             
End Sub

Public Sub ConfPagina(ByVal ws As String)
    With ThisWorkbook.Worksheets(ws).PageSetup
        .CenterHeader = "RESUMO DAS VERBAS RESCISÓRIAS"
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .FitToPagesTall = 1
        .FitToPagesWide = 1
        .Zoom = False
    End With
End Sub



Public Function SelectFolder() As String
Dim fileDialog  As fileDialog

    Set fileDialog = Excel.Application.fileDialog(msoFileDialogFolderPicker)
   
    fileDialog.Title = "Selecione a Pasta"
    If fileDialog.Show = True Then
        DoEvents
        SelectFolder = fileDialog.SelectedItems(1)
    End If

    Set fileDialog = Nothing

End Function

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/01/2017 9:18 am
 Gilbertob
(@gilbertob)
Posts: 40
Eminent Member
Topic starter
 

Valeu Bernardo.

Muito obrigado pela ajuda.

Um grande abraço,

Gilberto

 
Postado : 10/01/2017 7:29 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico