Grafisch duplicaat voor archivering en e-mail.

[Rikkerdepik]

Hallo,

Ik heb zojuist het stuk van factureren met excel gelezen op de microsoft site zoals weer meer mensen hebben gelezen denk ik.

Ik heb het bestand gedownload, macro's bekeken maar ik kom er niet uit om het toe te passen op mijn huidige offerte/factuur opmaak. Ik had nog even gekeken bij een andere vraag hierop maar daar kwam ik ook niet echt veder mee.

Kortom mijn vraag is, wat is de juiste macro code om een kopie op te slaan van het huidige werkblad.

http://www.helpmij.nl/forum/showthread.php/541085-Opslaan-PDF

http://www.microsoft.com/netherlands/artikelen/financien/factureren_met_excel_4.aspx#3


De code van microsoft:

[SQL]Public Sub FactuurMetAcceptBoeken()
ActiveSheet.Unprotect
If Val(Range("Totaal")) = 0 Then
i = MsgBox("Datum, Naam of Totaalbedrag ontbreekt")
Call Afsluiten
End If
Range("Accept").ClearContents
Range("H55") = "Factuur " + Str$(Range("Factuurnr.")) + " d.d. " + Str$(Range("Factuurdatum"))
x$ = Trim$(Range("Debiteurnr."))
If x$ > "" Then
Range("H56") = "Debnr. " + x$
Range("B67") = "Debnr. " + Range("Debiteurnr.")
End If
Eur = Int(Val(Range("Totaal")))
cent = 100 * (Range("Totaal")) - 100 * Eur
centen$ = Trim$(Str$(cent))
euro$ = Str$(Eur)
If cent < 10 Then centen$ = "0" + centen$
Range("B65") = "Factuur " + Str$(Range("Factuurnr."))
Range("B66") = "d.d. " + Str$(Range("Factuurdatum"))
Range("D58") = euro$
Range("F58") = centen$
Range("B62") = euro$
Range("C62") = centen$
Range("E65") = Range("D13")
Range("E66") = Range("D14")
Range("E67") = Range("D15")
Range("E68") = Range("D16")

Range("C62").HorizontalAlignment = xlRight
Range("F58").HorizontalAlignment = xlRight
Range("D55:O70").Font.Size = 12
Range("B55:C70").Font.Size = 9 ' controlestrook
If Len(euro$) > 1 And Len(euro$) < 11 Then Range("B62:C62").Font.Size = 13 - Len(euro$)
Range("B55:O70").Select
Selection.NumberFormat = "0" ' geen decimalen
Selection.NumberFormat = "@" ' tekst

AcceptGiro = 1
ActiveSheet.Protect
Call FactuurBoeken[/SQL]




Opslaan als pdf code:



[SQL]Private Sub CommandButton1_Click()
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
[A1:h54].Copy 'eventueel nog aan te passen
Workbooks.Add
With Selection
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
For Each Sh In Worksheets
If Sh.Index > 1 Then
Sh.Delete
End If
Next
With ActiveWorkbook
.SaveAs "C:\Documents and Settings\XP\Bureaublad\Factuur\" & [G11] & [B15] & [C10].Value & ".pdf"
.Close
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox "File is opgeslagen"
End Sub
[/SQL]

Hopelijk kan iemand hier iets mee, alvast bedankt!

 

[Breuk132]

Hallo,

Om een kopie op te slaan als pdf werkt dit beter denk ik.

Sub pdf_opslaan

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Documents and Settings\XP\Bureaublad\Factuur\" & [G11] & [B15] & [C10].Value & ".pdf", Quality:=xlQualityStandard_
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

MsgBox "File is opgeslagen"

End sub

Als je het toch als pdf opslaat is het omzetten van formules naar vaste waarden ook overbodig.