Van Excel naar Word en TabelSetup wdAutoFitWindow

[Tweety1]

Hoi,

Ik wil graag een Wordbestand aanmaken vanuit Excel (dat lukt) en dit Wordbestand vervolgens opmaken gaat ook goed alleen lukt het me niet om de tabel automatisch aan te passen aan de breedte van de pagina (wdAutoFitWindow). Ik heb al verschillende dingen geprobeerd alleen gebeurt er niks.

Sub ExportnaarWord()
Dim WdObj As Object, fname As String
Application.ScreenUpdating = False
On Error Resume Next
MkDir ThisWorkbook.Path & "\TEST"
On Error GoTo 0
fname = Range("Test").Value
Set WdObj = CreateObject("Word.Application")
    WdObj.Visible = False
'    Blad11.Visible = True
    Blad11.Range("A1:K4081").Copy
   ' Selection.Copy 'Your Copy Range
    WdObj.Documents.Add
   
With WdObj.ActiveDocument.PageSetup
   
   .Orientation = 1 'wdOrientLandscape
   .TopMargin = WdObj.InchesToPoints(0.3)
   .BottomMargin = WdObj.InchesToPoints(0.3)
   .LeftMargin = WdObj.InchesToPoints(0.3)
   .RightMargin = WdObj.InchesToPoints(0.3)
End With
      
WdObj.Selection.PasteExcelTable False, False, False

[COLOR="#FF0000"]'Dit stukje doet niks
WdObj.ActiveDocument.Tables(1).AutoFitBehavior wdAutoFitWindow[/COLOR]

  
With WdObj.ActiveDocument.Paragraphs
    .SpaceAfter = 0
    .SpaceBefore = 0
End With
   
WdObj.Selection.HomeKey Unit:=6 ' wdStory
   WdObj.Selection.MoveDown
   With WdObj.Selection.Find
    .Text = "          "
    .ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = 0 ' wdFindStop
    .MatchCase = False
    .MatchWholeWord = True
Do While .Execute
    WdObj.Selection.MoveDown
    WdObj.Selection.HomeKey
    WdObj.Selection.InsertBreak Type:=7 ' wdPageBreak
    WdObj.Selection.MoveDown
Loop
End With
Application.CutCopyMode = False

    If fname <> "" Then 'make sure fname is not blank
      With WdObj
      .ChangeFileOpenDirectory ThisWorkbook.Path 'save Dir
       .ActiveDocument.SaveAs filename:="TEST\" & fname
        End With
       Else:
       MsgBox ("File not saved, naming range was botched, guess again.")
        End If
      With WdObj
        .ActiveDocument.Close
        .Quit
       End With
     Set WdObj = Nothing
 '    Blad11.Visible = False
Application.ScreenUpdating = True
End Sub

Hieronder de stukjes die ik ik heb gebruikt maar niet werken.

WdObj.Selection.PasteExcelTable False, False, False

WdObj.Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

WdObj.ActiveDocument.Range.Tables(1).AutoFitBehavior wdAutoFitContent

With WdObj.ActiveDocument.Tables(1)
    .AutoFitBehavior wdAutoFitContent
End With
    
'With WdObj.Selection.Tables(1)
    '.AutoFitBehavior (wdAutoFitWindow)
    '.AutoFitBehavior (wdAutoFitWindow)
'End With