Makro til direkte "print" til PDF fra Excel

Ja. Du kan ikke lave en pdf-fil direkte, men skal danne en postscript-fil, der derefter konverteres til en pdf.

Se http://www.eksperten.dk/spm/773430, tidspunkt 16/04-2007 11:27:33

Jeg har nu prøvet din makro fra dit tidligere svar, men får følgende fejl i din 'create postscript file:
"Compile error - named argument not found", med følgende markeret: "outputfilename:="

Jf. word-hajen:

Det er dig, som har "tvunget" filen til at hedde test.pdf. Hvis du åbner den i f.eks. notepad, vil du i første linje se noget, der ligner "%!PS-Adobe-3.0". Dvs. at det ikke er en pdf, men en postscript-fil (test.ps).

Jeg tror heller ikke, at du kan automatisere sådan med PDF995. Den kræver ligesom den pause, som "Gem som"-dialogen giver. Efter tryk på "Gem-knappen" konverterer PDF995 ps-filen til pdf.

Men jeg lytter gerne med.

Her er lidt kode.
Den indsættes i et alm. modul, og kaldes så når der skal printes


Option Explicit

'Read INI settings
Declare Function GetPrivateProfileString Lib "kernel32" Alias _
                                        "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
                                                                    ByVal lpKeyName As Any, ByVal lpDefault As String, _
                                                                    ByVal lpReturnedString As String, ByVal nSize As Long, _
                                                                    ByVal lpFileName As String) As Long

'Write settings
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
                                          "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
                                                                        ByVal lpKeyName As Any, ByVal lpString As Any, _
                                                                        ByVal lpFileName As String) As Long

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub pdfwrite(outputfile As String, rng As Range)

    Dim syncfile As String, maxwaittime As Long
    Dim iniFileName As String, tmpPrinter As String
    Dim x As Long
    Dim tmpoutputfile As String, tmpAutoLaunch As String

    ' set the location of the PDF995.ini and the pdfsync files
    iniFileName = "C:\Program Files\pdf995\res\pdf995.ini"
    syncfile = "c:\documents and settings\all users\application data\pdf995\res\pdfsync.ini"
   
    Application.Goto rng
    ' save current settings from the PDF995.ini file
    tmpoutputfile = ReadINIfile("PARAMETERS", "Output File", iniFileName)
    tmpAutoLaunch = ReadINIfile("PARAMETERS", "Autolaunch", iniFileName)

    ' remove previous pdf if it exists
    On Error Resume Next
    Kill outputfile
    On Error GoTo Cleanup

    ' setup new values in PDF995.ini
    x = WritePrivateProfileString("PARAMETERS", "Output File", outputfile, iniFileName)
    x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName)

    ' change the default printer to PDF995
    ' if running on Access 2000 or earlier, comment out the next two lines
    tmpPrinter = Application.ActivePrinter
    Application.ActivePrinter = "PDF995 on Ne06:"
   
  Selection.PrintOut Copies:=1, Collate:=True

    ' cleanup delay to allow PDF995 to finish up. When flagfile is nolonger present, PDF995 is done.
    Sleep (10000)
    maxwaittime = 300000        'If pdf995 isn't done in 5 min, quit anyway
    Do While ReadINIfile("PARAMETERS", "Generating PDF CS", syncfile) = "1" And maxwaittime > 0
        Sleep (10000)
        maxwaittime = maxwaittime - 10000
    Loop

    ' restore the original default printer and the PDF995.ini settings
Cleanup:
    Sleep (10000)
    x = WritePrivateProfileString("PARAMETERS", "Output File", tmpoutputfile, iniFileName)
    x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", tmpAutoLaunch, iniFileName)
    x = WritePrivateProfileString("PARAMETERS", "Launch", "", iniFileName)
    On Error Resume Next
    Application.ActivePrinter = tmpPrinter

End Sub

Function ReadINIfile(sSection As String, sEntry As String, sFilename As String) As String
    Dim x As Long
    Dim sDefault As String
    Dim sRetBuf As String, iLenBuf As Integer
    Dim sValue As String
    sDefault$ = ""
    sRetBuf$ = String$(256, 0)        '256 null characters
    iLenBuf% = Len(sRetBuf$)
    x = GetPrivateProfileString(sSection, sEntry, _
                                sDefault$, sRetBuf$, iLenBuf%, sFilename)
    ReadINIfile = Left$(sRetBuf$, x)

End Function




---------------------------------------
For at kalde PDF-printet gøres således

Sub WRITE_MY_PDF_FILE()
    pdfwrite "c:\test3.pdf", Sheet1.Range("A1:G25")
End Sub

I stedet for at lave pdf'er med adobe kunne man jo f.eks bruge win2pdf ... og her spiller klaveret bare ...

Søren

Det kunne se ud til at spørgeren bruger PDF995 og ikke Adobe. Derfor den lidt lange kode

Ja, pdf995 kender jeg ikke ...

Men for win2 pdf fylder den ...

Sub Makro1()
  Range("a1:F12").Select
  Application.ActivePrinter = "Win2PDF på Ne00:"
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Printtofile:=True, Prtofilename:="c:\etellerandet.pdf", ActivePrinter:="Win2PDF på Ne00:", Collate:=True
End Sub

Jeg var så ikke lige opmærksom på, at det ikke var Adobe (sikkert en "vane-tankegang").

Tusind tak for jeres svar - Bak, dit fungerede lige i øjet, så det var helt perfekt... Nåede at blive så frusteret over Excel inden da, at jeg fandt en måde at få Excel til at lave billeder i stedet...

Hvis nogen skulle være interesseret, er koden til det her:
Dim outputnavne(20)
Dim i, strGIFFileName, ctoTheChartHolder, chtTheChart, picThePicture, sglWidth, sglHeight, blnRet
outputnavne(0) = "DagensKommentar"
strGIFFileName = "q:\s&m\salgsfokus\output\uge19-23\" & outputnavne(0) & ".gif"

                '  Copy the selection to the clipboard as a picture
                Range(outputnavne(0)).CopyPicture Appearance:=xlScreen, Format:=xlPicture
               
                '  Add a chart object to the activesheet
                Set ctoTheChartHolder = ActiveSheet.ChartObjects.Add(0, 0, 800, 800)
                Set chtTheChart = ctoTheChartHolder.Chart
                ctoTheChartHolder.Activate
                With chtTheChart
                .ChartArea.Select
                .Paste
                Set picThePicture = .Pictures(1)
                End With
                                           
                With picThePicture
                    .Left = 0
                    .Top = 0
                    sglWidth = .Width + 7
                    sglHeight = .Height + 7
                End With
                                 
                With ctoTheChartHolder
                    .Border.LineStyle = xlNone
                    .Width = sglWidth
                    .Height = sglHeight
                End With

                blnRet = chtTheChart.export(FileName:=strGIFFileName, _
                            Filtername:="GIF", Interactive:=False)
                ctoTheChartHolder.Delete
                Set ctoTheChartHolder = Nothing

Tak for jeres hjælp...

Hej Bak,

Tak for dit svar, men jeg kom vist til at give pointene til wordhajen... :-) (tak for din tid, også, mr. Haj)

Men BAK, kan du ikke lige svare på: http://www.eksperten.dk/spm/779393, så er der også point til dig...

Du har nu givet pointene til dig selv ;-)

ps! fru Haj

Dét er fløjteme smart.... Sorry... Håber bare Bak finder linket...