Adaptar para imprimir e printpreview no lugar de gerar pdf

2024 - VBA & Macros

Post Recente por Fabiano 8 anos atrás

4 Posts

2 Usuários

0 Reactions

903 Visualizações

RSS

Fabiano

(@alanisfcsm)

Posts: 0

Trusted Member

Topic starter

Boa tarde! esse código funciona perfeitamente para gerar uma 'PDF' de qualquer planilha em que a célula 'V2' for igual a '1'

Como posso adapta-la para:
1- Reutilizar uma copia do código para visualizar(printpreview) a página no lugar de criar uma 'PDF'

2- Reutilizar uma cópia do código para imprimir a página no lugar de criar uma 'PDF'

Sub Visualiza_Impressao_06()

Application.ScreenUpdating = False

    Dim Sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
   
    For Each Sh In Worksheets
             Sh.Visible = xlSheetVisible
    Next Sh
   
    TempFilePath = Environ$("temp") & ""
    TempFilePath = "D:PDF"

    For Each Sh In ThisWorkbook.Worksheets
        FileName = ""

        If Sh.Range("V2").Value Like "1" Then

             TempFileName = TempFilePath _
                         & Sheets("SET").Range("K19") _
                         & " - " _
                         & Sheets("A").Range("D1").Value _
                         & "" _
                         & Format(Sheets("SET").Range("B332").Value, "00000") _
                         & " - " _
                         & Format(Now, "dd-mm-yyyy") _
                         & ".pdf"

            FileName = RDB_Create_PDF(source:=Sh, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)

                       
            End If
        
    Next Sh
    
    For Each Sh In Worksheets

        If UCase(Sh.Name) <> UCase("A") Then
            Sh.Visible = xlSheetVeryHidden
        End If

    Next Sh
    
    Application.ScreenUpdating = True
    
End Sub

Postado : 22/09/2016 1:34 pm

Basole

(@basole)

Posts: 487

Reputable Member

Olá, veja se é isso que precisa:

Sub Visualiza_Impressao_06_1()

    Application.ScreenUpdating = False

    Dim Sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String

    For Each Sh In Worksheets
        Sh.Visible = xlSheetVisible
    Next Sh
    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Range("V2").Value Like "1" Then
        
            Sh.PrintPreview
            
        End If

    Next Sh

    For Each Sh In Worksheets

        If UCase(Sh.Name) <> UCase("A") Then
            Sh.Visible = xlSheetVeryHidden
        End If

    Next Sh

    Application.ScreenUpdating = True

End Sub

Click em se a resposta foi util!