• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Range opslaan als PDF met uniek nummer uit cel

Status
Niet open voor verdere reacties.

bos997

Gebruiker
Lid geworden
13 apr 2013
Berichten
5
Geachte Forummers,

Ik heb een fakturerings programma gebouwd dat fakturen produceert met unieke nummers, deze staan in cel H19 van tabblad "faktureren". Ik heb al een stukje code om relevante faktuurgegevens naar een tabel in een ander tabblad ("fakturen") te kopieren, zie hieronder.

Nu wil ik deze code graag uitbreiden met het automatisch opslaan als PDF van range A1:J53 van het tabblad "faktureren", waarbij het faktuurnummer uit cel H19 de naam van de PDF wordt. De doeldirectory staat in cel W1 van datzelfde tabblad.

Ik heb al verschillende codes geprobeerd (na zoeken op forum), maar de situaties zijn vaak net iets anders, waardoor ik foutmeldingen krijg die ik niet heb kunnen oplossen met mijn beperkte VBA kennis.
Daarom de vraag: Kan iemand mij aan de benodigde code helpen die ik onder mijn bestaande code kan plakken?

Bij voorbaat dank
bos997



Code:
Private Sub CommandButton1_Click()

Dim faktnr As String
Dim faktdatum As Date
Dim klantnr As Integer
Dim klant As String
Dim bedrag As Integer
Dim betalingstermijn As Integer

    Worksheets("faktureren").Select
    faktnr = Range("H19")
    faktdatum = Range("H20")
    klantnr = Range("I7")
    klant = Range("F8")
    bedrag = Range("H31")
    betalingstermijn = Range("D43")
    Worksheets("fakturen").Select
    Worksheets("fakturen").Range("A1").Select
    If Worksheets("fakturen").Range("A1").Offset(1, 0) <> "" Then
    Worksheets("fakturen").Range("A1").End(xlDown).Select
        End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = faktnr
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = faktdatum
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = klantnr
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = klant
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = bedrag
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = betalingstermijn
    Worksheets("faktureren").Select
    Worksheets("faktureren").Range("L7").Select
    

End Sub
 
Dit is de gehele code geworden.
Iets ingekort dus.
Code:
Private Sub CommandButton1_Click()
 Sheets("fakturen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6).Value = Array(Range("H19"), Range("H20"), Range("I7"), Range("F8"), Range("H31"), Range("D43"))
 Application.Goto Range("L7")
 With Sheets("faktureren")
 .PageSetup.PrintArea = "A1:J53"
 .Range("A1:J53").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        .Range("W1") & .Range("H19") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    End With
 End Sub
 
Harry,
Dank voor je reaktie, lekker kompakt geworden, noem dat maar 'iets korter'!
Code werkt vwb kopieren van faktuurgegevens naar tabel prima. Krijg echter bij het opslaan van de PDF een foutmelding 1004 met de boodschap 'Document niet opgeslagen. Mogelijk is het document nog geopend of is een fout opgetreden tijdens het opslaan.'
In foutopsporing wordt de laatste stap geel.

Dacht zelf aan een fout in het bestandspad uit cel W1, maar ook als ik dat aanpas naar C:\ blijft de melding bestaan.

Enig idee?
 
Deze fout kan ook optreden als je niet over de nodige schrijfrechten beschikt. Al eens geprobeerd naar een USB-stick te schrijven ?
 
Warme Bakkertje,
Lijkt erop dat je gelijk hebt, naar USB gaat wel. Raar, want ben administrator en kan wel handmatig opslaan daar. Hoe zou ik dat moeten wijzigen?

Edit 11-05: Is inmiddels gelukt; bedankt voor de hulp
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan