xls opslaan als pdf in bepaalde directory met vba

Status
Niet open voor verdere reacties.
N

Nousje

Gebruiker
Lid geworden
23 nov 2009
Berichten
44
Ik ben een vba-code aan het schrijven om een exceldocument middels een macro te printen als pdf(opslaan als) en deze dan te laten opslaan in een vooraf gedefinieerde map met als naam een bepaalde cel. Nadat deze pdf is opgeslagen wordt je doorgeleid middels een hyperlink naar een email van waaruit je de pdf kan oproepen om deze te attachen en te versturen. Wat met mijn code gebeurt is dat het document wel wordt opgeslagen maar het kan niet geopend worden(foutcode van Adobe - bestand beschadigd). Ik wordt wel automatisch naar de email geleid.
Deze code heb ik tot nu toe:
Dim MyName
MyName = Range("A17").Value
ChDir "\\Naam map\\"
ActiveWorkbook.SaveAs Filename:=MyName & ".pdf"
ActiveWindow.SmallScroll Down:=-36
Range("A17").Select
Range("A15").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.SmallScroll Down:=27

Ik surf nu al tijden op het net en kan niet vinden wat ik moet hebben...
Wie o wie snapt wat ik bedoel en kan mij helpen:)???
 

Bijlagen

Laatst bewerkt:
Nousje,

Kijk eens hier, misschien is het voor jou ook de oplossing.
 
Thx Hoornvan, maar helaas is dit m niet...
de macro geeft een foutmelding: "Fout 424 tijdens uitvoering: Object vereist"
Natuurlijk heb ik de naam van de betreffende map gewijzigd.
Ook lijkt me dat als ik deze wel werkend zou krijgen het opslaan onder de naam van de cel zo niet lukt.
Nu ziet de macro er zo uit:
Dim MyName
MyName = Range("A17").Value
activedocument.ExportAsFixedFormat "\\map", wdExportFormatPDF
ActiveWorkbook.ExportAs Filename:=MyName & ".pdf"
ActiveWindow.SmallScroll Down:=-36
Range("A17").Select
Range("A15").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.SmallScroll Down:=27
Ik werk met PDF995, zou dat wat uitmaken?
 
Zou het kunnen dat de invoegtoepassing niet in Excel 2003 werkt?:(
Wat ik ook rommel, hij blijft de foutcode aangeven...
Het zou al voldoende zijn als ik de code weet die "zegt" dat het xls bestand als pdf moet opslaan als cel A17 in een bepaalde map.
De rest krijg ik vast wel werkend...
Is het niet zoiets als "PrintAs" of "PrintTo"?
Thanks alvast voor je moeite!;)
 
Ik gebruik ook CutePDF voor het maken van PDF-bestanden. Je kunt ook in je macro aangeven naar welke printer er afgedrukt moet worden:

Code: 
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "CutePDF Writer op CPW2:", Collate:=True
 
Dank je wel, dat werkt.:thumb:
Maar hoe laat ik de pdf dan automatisch opslaan in een map met de naam uit cel A17?
 
Dat zal zo niet lukken verwacht ik. Tenzij je Excel en CutePDF of de één of andere manier met elkaar kunt laten communiceren (API? Commandline?)

Denk er eens over om te upgraden naar Office 2007. In dat geval zou ik het zo doen:

Code: 
Sub PdfMaken()
Dim Pad As String
Dim BestandsNaam As String
Pad = ActiveWorkbook.Path + "\"
BestandsNaam = Sheets("Beheer").Range("A1").Value
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=Pad + BestandsNaam, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Ik kwam met Google ook nog deze tegen: http://www.rondebruin.nl/pdf.htm
 
Helaas kan ik niet upgraden naar 2007 omdat ik vastzit aan 2003 doordat dit op mijn werk gebruikt wordt...Maar!>>>

Ik heb het nu zo opgelost:
ChDir _
"\\pad\FAXEN"
ActiveWorkbook.saveas Filename:= _
"\\pad\FAXEN\123456.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.ActivePrinter = "CutePDF Writer op CPW2:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWindow.SmallScroll Down:=-36
Range("A17").Select
Range("A15").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.SmallScroll Down:=27
Close

Nu slaat excel het bestand eerst op, vervolgens print deze het betreffende blad naar pdf en slaat (na OK in het pop-up scherm) deze op in het door mij aangegeven pad met de vooraf gedefinieerde naam. Daarna word ik doorgeleid naar lotus Notes middels een hyperlink in mijn document en kan ik het document in de mail hangen.
Voor mij werkt het zo ook prima.

Iedereen bedankt voor de input, mede door jullie ben ik uiteindelijk hier op gekomen!!!;)
 
Slim! :)

Misschien kun je het document ook automatisch laten verwijderen uit FAXEN als je dat nodig vindt.
 
Nousje zei:
aha das een goeie!
Geen idee hoe!
Jij misschien?
Klik om te vergroten...

Zoek eens in de helpfile op "Delete, methode". Lijkt me wel handig om dat te doen in Private Sub Workbook_BeforeClose(Cancel As Boolean). Anders ga je een bestand verwijderen dat nog geopend is.

Beter nog: "Kill, instructie`
 
Laatst bewerkt:
Ziet er goed uit!;)
Maar ik hoef het xlsbestand niet te verwijderen, alleen de pdf dan.
Die dient nl. alleen als "post' om per email te versturen.
Ik heb er een logo als koptekst en ondertekening als voettekst instaan die die als pdf alleen meepakt.

Ik heb het wel in mijn eigen VBA-logboek gezet zodat ik het later alsnog kan gebruiken.
:thumb: voor het meedenken!
 
jahaaaaaaaaaaaaaaaaaaa!
Ook die werkt!
Ik geef aan KILL "pad\bestand"
en dan doetie dat gewoon!
Dus geen onnodige opslag.
Topperrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr:thumb:
Daarvoor heb ik een vertraging ingebouwd met een Msgbox dat het bestand na 20 sec wordt verwijderd.
Kijk maar:
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 20
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
If Application.Wait(Now + TimeValue("0:00:20")) Then
MsgBox "Tijd om!"
Kill "\\pad\bestand.pdf"
 
Laatst bewerkt:
Slim die delay, dan heb je tijd om de PDF te verzenden. Je zou natuurlijk ook gewoon een MsgBox kunnen maken die vraagt "Ben je klaar om de .pdf te verwijderen?" Ja/Nee.

Mag ik je ook wijzen op deze mogelijkheid?

Code: 
On Error Resume Next
If ThisWorkbook.Path = "\\pad\FAXEN" Then Kill ThisWorkbook.Path + "\Bestandsnaam.pdf"

Alle .pdf-bestanden in een map verwijderen (pas daar wel mee op natuurlijk):
Code: 
On Error Resume Next
If ThisWorkbook.Path = "\\pad\FAXEN" Then Kill ThisWorkbook.Path + "\*.pdf"

Hoe heb je trouwens de te verwijderen bestandsnaam vastgesteld? Handmatig? Want die zou je automatisch kunnen vaststellen aan de hand van ThisWorkbook.Name, zodat er geen fouten optreden als de bestandsnaam van je Excelbestand gewijzigd wordt. Je moet dan alleen een manier vinden om de extensie te veranderen van .xls in .pdf, maar ik geloof dat ik daarvoor al draadjes heb gezien op dit forum.

Handiger zou zijn als je de PDF met een macro automatisch kunt verzenden, maar daar kan ik je even niet mee helpen. Ik ken alleen maar deze: ThisWorkbook.SendMail, waarmee het Excelbestand via E-mail verzonden wordt.
 
Ja, zou nog makkelijker zijn inderdaad om de naam "automatisch"te laten pakken.
Dat heb ik eerst wel geprobeerd met
Dim MyName
MyName = Range("A17").Value
Maar om deze dan ook mee te kunnen geven bij het opslaan als(pinten naar) pdf is me dat nog niet gelukt.
Waarschijnlijk heeft dat te maken met Excel 2003?...
De tekst in de MsgBox kan ik gewoon aanpassen naar wat ik wil volgens mij.
Daar ga ik nog op broeden...

:thumb: weer voor het meedenken!
 
Ik heb het zo gedaan:

Code: 
Dim Pad As String
Dim Bestand As String
Dim BestandsNaam As String
Dim Datum As String
Dim Jaar As String

Jaar = Year(Date)
Datum = Date
Pad = Sheets("Beheer").Range("B7").Value
Bestand = "Bestelling Jumbo " + Datum + ".xls"
BestandsNaam = Pad + "\Bestellingen Jumbo " + Jaar + "\" + Bestand

SlaOpAls:
  Sheets("Norm").Select
  On Error Resume Next
  MkDir (Pad + "\Bestellingen Jumbo " + Jaar)
  Application.DisplayAlerts = False
   ThisWorkbook.SaveAs (BestandsNaam), FileFormat:=xlNormal
  Application.DisplayAlerts = True
SkipOpslaan:

Verder heb ik ook een stukje geschreven om erachter te komen of de bestandsnaam waaronder ik wil opslaan al bestaat. Dat is misschien ook handig voor jou, om na te gaan of je .pdf gekild moet worden of niet.

Code: 
Dim BestandEx As String

ReedsGestart:
  BestandEx = Dir(BestandsNaam)
  If BestandEx = Bestand Then

    If MsgBox("Er is al een bestelling gestart vandaag. Wil je deze openen?", vbYesNo, "Bestelling reeds gestart") = vbYes Then
        Workbooks.Open (BestandsNaam)
        ThisWorkbook.Close SaveChanges:=False
    Else
        'If MsgBox("Wil je de eerdere bestelling van vandaag vervangen door een nieuwe?", vbYesNo, "Oude bestelling overschrijven") = vbYes Then GoTo SlaOpAls
                On Error Resume Next
        MkDir (Pad + "\Bestellingen Jumbo " + Jaar)
        fName = Application.GetSaveAsFilename(BestandsNaam, "Excel-werkmap (*.xls), *.xls", , "Sla de nieuwe Jumbo bestelling op")
        If fName <> False Then ThisWorkbook.SaveAs fileName:=fName, FileFormat:=xlNormal
        GoTo SkipOpslaan
    End If

  End If

Jij zou dus iets moeten kunnen met Kill BestandsNaam . Máár je wil natuurlijk niet de .xls verwijderen maar de .pdf. Maar er is vast een manier om de laatste drie tekens in een string aan te passen. ;)

Verder wil ik je voor je stukje 'printen' nog wijzen op de mogelijkheid om een bepaalde selectie te laten afdrukken (naar .pdf dus) in plaats van de hele sheet.

Code: 
Dim AdrukSelectie As String
AfdrukSelectie = Sheets("Beheer").Range("C13").Value + ":" + Sheets("Beheer").Range("E13").Value
Range(AfdrukSelectie).PrintOut

In dit voorbeeld wordt elders in het document aangegeven wat de eerste en de laatste cel is van het af te drukken bereik. Dit kan natuurlijk ook gewoon met een vaste waarde:

Code: 
Dim AdrukSelectie As String
AfdrukSelectie = "A15:K50"
Range(AfdrukSelectie).PrintOut
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan