convert .mpp to .pdf

This code works for printing in excel to pdf without the filename dialog box (need to make sure SEND FONTS TO ADOBE is unchecked in the printers -> properties box, also prompt for filename is unchecked too)

hope it helps!


Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppname As String, ByVal LpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Public Sub PrintToPdf(ws As Sheets, out As String, path As String)
    ' sheets must be VISIBLE to print -
    ' ActiveSheet.PageSetup must be defined for the range you want to print or the whole sheet will print
    Dim myPDF As PdfDistiller, PSfilename As String, PDFfilename As String
    Set myPDF = New PdfDistiller
    ' Define the postscript filename
    PSfilename = docpath & "temp.ps"
    ' Define the .pdf filename
    PDFfilename = out
    ws.PrintOut Copies:=1, Preview:=False, ActivePrinter:=ChoosePrinter(pdfPrinter), PrintToFile:=True, Collate:=True, PrToFilename:=PSfilename
    myPDF.FileToPDF PSfilename, PDFfilename, ""
    Kill path & "temp.ps"
    Kill path & "*.log"
End Sub

Public Function ChoosePrinter(printerType As String) As String
  Dim vaList, i
  'Get all printers
  vaList = PrinterFind
  For i = 0 To UBound(vaList)
    If Mid(vaList(i), 1, 11) = printerType Then
        ChoosePrinter = vaList(i)
        Exit For
    End If
  Next i

End Function
Public Function PrinterFind(Optional Match As String) As String()
  Dim n%, lRet&, sBuf$, sCon$, aPrn$()
  Const lLen& = 1024, sKey$ = "devices"


  '-----------------------------­------------------------------­-------
  'written by keepITcool


  'requires xl2000 or newer.
  'returns a zerobased array of complete localized printer strings
  'results are filtered on Match string, if no result the ubound = -1
  '-----------------------------­------------------------------­-------


  'Split ActivePrinter string to get localized word for "on"
  aPrn = Split(Excel.ActivePrinter)
  sCon = " " & aPrn(UBound(aPrn) - 1) & " "


  'Read all installed printers (1k bytes s/b enough)
  sBuf = Space(lLen)
  lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lLen)
  If lRet = 0 Then
    Err.Raise vbObjectError + 513, , "Can't read Profile"
    Exit Function
  End If


  'Split buffer string
  aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
  'Filter array on Match
  If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)


  For n = LBound(aPrn) To UBound(aPrn)
    'Add 16bit portname for each Printer
    sBuf = Space(lLen)
    lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lLen)
    aPrn(n) = aPrn(n) & sCon & _
    Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
  Next
  'Return the result
  PrinterFind = aPrn


End Function