word doc. printen als pdf vanuit excel

[sylvietoin]

Beste formumleden,

vraagje,

via excel copier ik een range naar word
het nieuwe word-bestand wordt op netwerk geplaatst en opgeslagen
werkt goed, maar
nu wil ik mbv VBA van dit word-bestand een pdf maken welke wordt opgeslagen in zelfde dir, en met zelfde naam
zou volgens mij moeten werken met deze code

'Print the Word document
oWordDoc.PrintOut

'Rename the Word document as pdf
oWordDoc.SaveAs sPath & Replace(sFileName, "docx", "pdf")

'Close Word Application
oWordApp.Quit

werkt echter niet
weet iemand wat er nog aangepast moet worden?

hoor het graag

gr
Toin

 

[edmoor]

Maak er eens dit van:
oWordDoc.SaveAs2 sPath & Replace(sFileName, "docx", "pdf"), 17

 

[sylvietoin]

Hoi Edmoor,

bedankt voor je input,

werkt met jouw aanpassing, geweldig bedankt,
van saveas2 kan ik nog wel volgen, maar waarom , 17?
waar staat deze voor?

gr
Toin

 

[edmoor]

Die 17 laat aan Word weten dat het document in PDF formaat moet worden opgeslagen.
Zie:
https://msdn.microsoft.com/en-us/library/office/ff839952.aspx

 

[tkint]

@sylvietoin,

Wil je eens de code publiceren hoe je een excelrange kopieert naar Word en opslaat in Word?

 

[sylvietoin]

Beste tkint, forum leden,

code heb ik ook via dit forum aangeleverd gekregen en naar mijn wensen aangepast

Sub copier range vanuit excel naar word ()

'This routine will export a range to a Word document
'It opens Word, paste header, paste the Excel range, stores the Word document, prints the doc, save as pdf and closes the Word application

Dim oWordApp As Object
Dim oWordDoc As Object
Dim oWSH As Object
Dim rExport As Range
Dim sFileName As String, sPath As String
Dim i As Long, i2 As Long
Dim WordHeader As String

Set rExport = Worksheets("Verzendadvies").Range("c39:i96") '<- Change as needed

'Find the path to cel BE2 (pad naar dir waar doc. opgeslagen moet worden)

Set oWSH = CreateObject("WScript.Shell")
sPath = Worksheets("Tek-Lijst").Range("BE2") & "\"
'Assemble a filename for the Word document
'In this case use the value that is in the first cell of the exported range and append date
sFileName = Range("e47") & "-" & "Verzendadvies(1)"
'Optional: make sure you have a unique filename
i = 1
While FileExists(sPath & "\" & sFileName & ".docx")
i2 = InStr(1, sFileName & ".docx", "(", vbTextCompare)
If i2 = 0 Then
sFileName = sFileName & "(" & i & ")"
Else
sFileName = Left(sFileName & "Verzendadvies.docx", i2) & i & ")"
End If
i = i + 1
Wend

'Create a Word document.
Set oWordApp = CreateObject("Word.Application")

'Make the newly created Word instance visible
oWordApp.Visible = True

'Create a new document
Set oWordDoc = oWordApp.Documents.Add

'Insert Header
WordHeader = sFileName
oWordApp.ActiveDocument.Sections(1).Headers(1).Range.InsertAfter WordHeader

'Copy data
rExport.Copy

'Paste Excel range in Word (will be pasted in a table)
oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine

'Save the Word document
oWordDoc.SaveAs2 sPath & sFileName, wdFormatDocument

'Print the Word document
oWordDoc.PrintOut

'Rename the Word document as pdf
oWordDoc.SaveAs2 sPath & Replace(sFileName, "docx", "pdf"), 17

'Close Word Application
oWordApp.Quit

End Sub

'FileExists Function -> geeft TRUE terug als de file bestaat
Function FileExists(fname As String) As Boolean
FileExists = Dir(fname, vbNormal) > Empty
End Function

bovenstaande code copierd 1 range
indien meerdere ranges gecopierd moeten worden geldt onderstaande

Dim oWordApp As Object
Dim oWordDoc As Object
Dim oWSH As Object
Dim rExport1 As Range
Dim rExport2 As Range
Dim rExport3 As Range
Dim sFileName As String, sPath As String
Dim i As Long, i2 As Long
Dim WordHeader As String

Set rExport1 = Worksheets("Verzendadvies").Range("c35:j38") '<- Change as needed
Set rExport2 = Worksheets("Verzendadvies").Range("q47:v52") '<- Change as needed
Set rExport3 = Worksheets("Verzendadvies").Range("c56:j80") '<- Change as needed

'Copy data range 1
rExport1.Copy

'Paste Excel range in Word (will be pasted in a table) range 1
oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine

'Copy data range 2
rExport2.Copy

'Paste Excel range in Word (will be pasted in a table) range 2
oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine

'Copy data range 3
rExport3.Copy

'Paste Excel range in Word (will be pasted in a table) range 3
oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine

ben er best trots op dat het werkt, doe er je voordeel mee

gr
Toin