Problem with macro saving Excel sheets to PDF using Distiller 1

[mikedill]

Hi,
I have a macro that I use to save multiple sheets of an Excel file to a single PDF. It works in most situations, but is giving me fits in one file.

I select all the sheets I want in the PDF and then run the macro. It prompts me for the directory location to save and supplies a file name.

Then, it starts saving the PDF. But, when it hits a certain sheet it displays the file-save dialog box and starts saving the remaining pages in a different PDF.

Does anyone know what could be causing my problem? All of the sheets contain differently formatted columns, so I doubt that is the issue.

My code is posted below. Thanks in advance for your help,
Mike

****************
Sub PrintToPDF()
Dim myPDF As PdfDistiller
Set myPDF = New PdfDistiller

direct = BrowseForDirectory
thisfilename = ActiveWorkbook.Name
periodchar = InStr(1, thisfilename, ".&quot
basefilename = Left(thisfilename, periodchar - 1)

' Print the Excel range to the postscript file
Application.ActivePrinter = "Acrobat Distiller on Ne01:"
ActiveWindow.SelectedSheets.PrintOut copies:=1, ActivePrinter:= _
"Acrobat Distiller on Ne01:", collate:=True, PrToFileName:="c:\WINNT\Temp\" + basefilename + ".ps"
' Convert the postscript file to .pdf

myPDF.FileToPDF "c:\WINNT\Temp\" + basefilename + ".ps", direct + "\" + basefilename + ".pdf", ""

End Sub

Private Type BrowseInfo
hWndOwner As Long
pidlRoot As Long
sDisplayName As String
sTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (bBrowse As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" (ByVal lItem As Long, ByVal sDir As String) As Long

Private Function BrowseForDirectory() As String
Dim browse_info As BrowseInfo
Dim item As Long
Dim dir_name As String

'modified for MS Access/VBA
With browse_info
.pidlRoot = 0
.sDisplayName = Space$(260)
.sTitle = "Select Directory to save .PDFs:"
.ulFlags = 1 ' Return directory name.
.lpfn = 0
.lParam = 0
.iImage = 0
End With

item = SHBrowseForFolder(browse_info)
If item Then
dir_name = Space$(260)
If SHGetPathFromIDList(item, dir_name) Then
BrowseForDirectory = Left(dir_name, _
InStr(dir_name, Chr$(0)) - 1)
Else
BrowseForDirectory = ""
End If
End If
End Function

 

[Murgle]

Check to make sure that the print settings for all of your sheets are the same - I remember seeing a thread where this caused problems. Ahhhhh, I see you have a machine that goes Bing!