range vanuit excell coperien naar word in template

[sylvietoin]

beste formumleden

vraagje
ik heb een bestand in excell waarvan ik een bep. range copieer naar word
gaat goed, alleen, omdat (standaard) regelafstanden in word inmiddels gewijzigd zijn, waardoor de range nu niet meer standaard op één pagina past,
moet ik de teksthoogte en regelafstand steeds handmatig aanpassen
darom wil ik de range in een template (word) plaatsen
met regelafstand, teksthoogte ed zodanig dat range weer wél op één pagina valt

verder,
hiermee voorkom ik ook om ditzelfde steeds bij verschillende computers te moeten doen
hoe doe je dit met VBA?

vanwege de grootte v/h bestand alleen de code bijgevoegd
hoor graag jullie oplossing

gr
Toin

Sub Verzendadvies()
'Toin Scheepers created this routine dd 20-12-2008.
'
'This routine will export a range to a Word document
'It opens Word, paste header, paste the Excel range, stores the Word document 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 "P:/ordernr./05 Correspondentie/05B Correspondentie Derden VERZENDADVIEZEN"
    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

 

[edmoor]

Neem in Word een macro op als je die wijzigingen handmatig toepast. In de macro zie je dan wel hoe je dat in VBA moet doen.

 

[sylvietoin]

Hoi Edmoor,

bedankt voor je reactie,
ik heb een macro in word opgenomen om opmaak te wijzigen nadat een bep. Range vanuit excel in word-doc. is geplakt
de opmaak wijzigen wordt onderdeel van meer acties welke onder dezelfde opdrachtknop moet komen

vervolgens code gecopierd naar VBA in excel-bestand en aangepast
krijg het echter niet werkend
heeft denk ik te maken dat VBA moet weten dat commando in word uitgevoerd moet worden
om dit kenbaar te maken moet iets gedaan worden met owordapp of oworddoc oid. maar hoe precies weet/begrijp ik niet

Sub Macro32()
'
' Macro32 Macro
'
    objectSel.WholeStory
    Selection.Style = ActiveDocument.Styles("Standaard")
    Selection.Font.Size = 9
    Selection.Font.Name = "Calibri"
End Sub

Omgebouwd tot

    ' Resize Text
    owordapp.Selection.WholeStory
    Selection.Style = ActiveDocument.Styles("Standaard")
    Font.Size = 9.Font.Name = "Calibri"

na regel

owordapp.Selection.WholeStory

loopt het vast

weet iemand hoe dit probleem aan te pakken?

gr
Toin

 

[edmoor]

Je gebruikt hier een object dat je kennelijk niet aangemaakt hebt:
owordapp.Selection.WholeStory
Die owordapp zal niet bestaan.