Jump to content
Fórum Script Brasil
  • 0

Como deixar o codigo vba mais rapido na impressão em pdf?


Question

Estou com problemas na hora da impressão da planilha de registro: RD - Diferenciados, passa mais de 40 min, as vezes ate mais, para fazer a impressão, queria deixa-la como as outras que são praticamente instantâneas. Vou mandar a parte do código(vba) aqui.

att.

'Classificar Colunas

    ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort.SortFields.Add Key _
        :=Range("C8:C" & i), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort.SortFields.Add Key _
        :=Range("B8:B" & i), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A8:A" & i), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RD - Diferenciados").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

    
    'Formatar dados

    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
    Columns("D:E").Select
    Selection.NumberFormat = "General"
    
Application.Calculation = xlAutomatic
    
' Área de Impressão
u = Application.Match("", Sheets("RD - Diferenciados - Resumo").Range("A:A"), 0) - 1
Sheets("RD - Diferenciados - Resumo").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$C$" & u


' Gerar PDF

'nome do arquivo RD - Registro'
filenameA = Sheets("Cadastro").Cells(3, 2) & "-" & Sheets("Cadastro").Cells(3, 3) & "-" & Sheets("Cadastro").Cells(3, 4) & " à " & Sheets("Cadastro").Cells(4, 2) & "-" & Sheets("Cadastro").Cells(4, 3) & "-" & Sheets("Cadastro").Cells(4, 4) & "_02_08_Diferenciados_RD"
  
'Impressao  RD - Diferenciados'
With Sheets("RD - Diferenciados")
 .ExportAsFixedFormat _
  Type:=xlTypeXPS, _
  Filename:=filenameA, _
  OpenAfterPublish:=True
End With

'nome do arquivo RD - Resumo'
filenameQ = Sheets("Cadastro").Cells(3, 2) & "-" & Sheets("Cadastro").Cells(3, 3) & "-" & Sheets("Cadastro").Cells(3, 4) & " à " & Sheets("Cadastro").Cells(4, 2) & "-" & Sheets("Cadastro").Cells(4, 3) & "-" & Sheets("Cadastro").Cells(4, 4) & "02_08_Diferenciados_RD_Resumo"
  
'Impressao  RD - Diferenciados'
With Sheets("RD - Diferenciados - Resumo")
 .ExportAsFixedFormat _
  Type:=xlTypeXPS, _
  Filename:=filenameQ, _
  OpenAfterPublish:=True
End With

End If
End If



 

Link to post
Share on other sites

1 answer to this question

Recommended Posts

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      148689
    • Total Posts
      644524
×
×
  • Create New...