The suspect part is the print and conversion.
I would comment out the print and conversion parts and run the macro - if
you don't see a slowdown, then you can assume it is in the print.
I would then comment out just the conversion and see if the there is a
slowdown with just the print.
If so, and there is a good chance there will be, then you might need to only
print 400 records at a time, then save and close the workbook/excel, then
print the next 400.
--
Regards,
Tom Ogilvy
The code is kind of extensive! But i´ll try to post it
here with coments!
Sheet "base da Dados" has the Database (information)
sheet "Graf" has the information of row 2(formated and
ready to make a pdf)
I hope it helps
SpeeD
´ if there is information in the row all the procedure
begins if not the macro ends...
Do While Worksheets("Base Dados").Range("A2").Value
<> ""
Application.ScreenUpdating = False
Sheets("Graf").Select
For x = 1 To Worksheets("Graf").Range("A3").Value
If Range(Range("A1").Value & x).Value = "" Or
Range(Range("A1").Value & x).Value = 0 Then
Rows(x).EntireRow.Hidden = True
End If
Next x
' Processo to prnt to PDF
Sheets("Graf").Select
Range("B3").Select
' 1as 2 linhas do Dim
PSFileName = ThisWorkbook.Path & "\" & "Temp
PS" & "\" & "myPostScript.ps"
If Range("A2").Value <> "" Then
PDFFileName = ThisWorkbook.Path & "\" &
Worksheets("Opções").Range("C5").Value & "\" & Worksheets
("Opções").Range("C5").Value & "-" & Range("A2").Value
& ".pdf"
End If
' Print the Excel range to the postscript file
' 3a 2 linhas do Dim
Set MySheet = ActiveSheet
ActiveSheet.PrintOut copies:=1,
preview:=False, _
ActivePrinter:="Acrobat Distiller",
printtofile:=True, _
collate:=True, prtofilename:=PSFileName
' Convert the postscript file to .pdf
' 4a e 5ª 2 linhas do Dim
myPDF.FileToPDF PSFileName, PDFFileName, ""
Kill (PSFileName)
´Delete the current record and switch = to . to prevent
#REF in sheet graf
Rows("1:50").Select
Selection.EntireRow.Hidden = False
Sheets("Graf").Select
Cells.Replace What:="=", Replacement:=".",
LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False,
SearchFormat:=False, ReplaceFormat:=False
Sheets("Base Dados").Select
Do While Range("A2").Value = Range("A3").Value
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Loop
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Sheets("Graf").Select
Cells.Replace What:=".", Replacement:="=",
LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False,
SearchFormat:=False, ReplaceFormat:=False
Sheets("Opções").Select
Application.ScreenUpdating = True
' Refresh the PDF´s counter cell in the opçoes sheet
Set fs = Application.FileSearch
With fs
.LookIn = ThisWorkbook.Path & "\" & Range
("C5").Value
.SearchSubFolders = True
.FileName = "*.PDF"
If .Execute() > 0 Then
Range("B16").Value = .FoundFiles.Count
End If
End With
Loop
