&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&& Automatic
&&&&&&& Excel/Word (and HTML w/Word)
&&&&&&& to PS to PDF Module
&&&&&&&
&&&&&&& Use with Bob Lee's ps2pdf
&&&&&&& Posted at Tek-Tips in FAQ
&&&&&&& faq184-2143 by mgagnon
&&&&&&&
&&&&&&& Brian Altman
&&&&&&& 10/25/2003
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
*Infile="MyXL.xls"
InFile="MyWord.doc"
&& Test to make sure file exists, if not go fish
IF FILE(InFile)=.f.
MissingFile=MESSAGEBOX("File no longer exists or was moved. Do you want to look for it?","Missing Input File",4)
IF MissingFile=6
InFile=GETFILE()
ELSE
RETURN
ENDIF
ENDIF
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&Flipped App to use depending on file extension
m.ext=UPPER(JUSTEXT(infile))
DO case
CASE m.ext=="RTF" OR m.ext=="DOC" OR m.ext=="HTM" OR m.ext=="HTML" OR m.ext=="TXT"
typeoffile="WORD"
CASE m.ext=="XLS" OR m.ext=="CSV"
typeoffile="XL"
OTHERWISE
MESSAGEBOX("Only File Extensions of 'XLS', 'CSV', 'DOC', 'RTF', 'TXT','HTM' and 'HTML' are currently supported","File Error",0)
RETURN
ENDCASE
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
If Not Directory("psfiles")
Mkdir psfiles
Endif
If Not Directory("pdffiles")
Mkdir pdffiles
Endif
&&Your PS (output) file to be used by Bob Lee's ps2pdf
PSfile=sys(5)+sys(2003)+"\Output.PS"
PrinterToUse="Lexmark Optra Color 1200 PS"
&&Your Current Default Printer so we can go back to it.
&&Saved as a text file so you can get it back by executing
&&the 'ON ERROR DO OLDPRINTER'
lcDefaultPrinter = SET("PRINTER",3)
STRTOFILE(lcDefaultPrinter,"oldprinter.txt")
PMISSING="N"
ON ERROR PMISSING="Y"
oNet = CREATEOBJECT("WScript.Network")
oNet.SetDefaultPrinter(PrinterToUse)
IF m.PMISSING="Y"
MESSAGEBOX("Please Add Printer '"+PrinterToUse+"' as a Print-to-File Printer"+CHR(13)+;
"Using 'Printers/Faxes->Add Printer Wizard' in the control pannel.","PS Printer Not Found",0)
RETURN
ENDIF
ON ERROR DO OLDPRINTER
&&Print the Excel File to a Postscript File
IF m.typeoffile="XL"
loExcel = CreateObject("Excel.Application")
WITH loExcel
.DisplayAlerts = .f.
.Visible=.f.
.Workbooks.Open(Infile)
&&Sendkeys automates the forced 'name output file' pop-up
&&You may have to tweak this line by adding an additional
&&{ENTER} or whatever depending on the interface presented
&&by your OS/Office version. This worked in Office XP.
&&Note the macro replacement for the file name.
Code:
.SendKeys ["%f%l&PSFile{ENTER}"]
DECLARE Sleep IN Win32API INTEGER nMilliseconds
Sleep(1000) &&wait for a bit for the print box- might need to raise this for slow computers
&&Prints whole workbook, can use commented out code to print just 1st sheet
.ActiveWorkbook.PrintOut &&whole wb
*.ActiveWorkbook.PrintOut(1,.t.,.t.) &&1st sheet
.Quit
ENDWITH
loExcel=.null.
ELSE
loWord = CreateObject("Word.Application")
WITH loWord
.DisplayAlerts = .f.
.Visible=.f.
.Documents.Open(InFile)
.ActiveDocument.PrintOut(0,0,0,PSFile)
.Quit
ENDWITH
loWord=.null.
ENDIF
&&Return to original default printer
oNet.SetDefaultPrinter(lcDefaultPrinter)
&&Execute Bob Lee's ps2pdf assumed to be in same folder
ON ERROR
ps2pdf(PSfile)
&&If something goes wrong and you want your
&&original default printer back execute this code:
PROCEDURE OLDPRINTER
lcDefaultPrinter = FILETOSTR("oldprinter.txt")
oNet = CREATEOBJECT("WScript.Network")
oNet.SetDefaultPrinter(lcDefaultPrinter)
MESSAGEBOX("Error! Please Check Printer Driver and MS Office Availability."+CHR(13)+;
"Printer Returned to Default.","Conversion to PS Error",0)
ON ERROR
ENDPROC
