title: Excel VBA - Autofit multiple charts & tables into word at bookmarks?
body: <p>I am struggling to add Autofit to my sub when pasting multiple chats and tables into word at defined bookmarks. I have tried multiple methods, but my lack of experience is showing through and the sub either fails or does not autofit when I add/mess with autofits. </p>
  
  <p>It runs fine as it stands below:</p>
  
  <pre><code>'To open a template word file '"C:\Users\USER\Documents\Custom Office  Templates\Test161231.dotm"
  'To copy ranges and charts as referenced on this excel workbook sheet "Bookmarks"
  'To paste ranges and charts at predefined bookmarks within the open word    template as referenced on this excel workbook sheet "Bookmarks"
  'To save the open word template as a .Docx
  
  Sub OpenPopulateSave()
  
  Dim wApp As Word.Application
  Dim wDoc As Word.Document
  Set wApp = CreateObject("Word.Application")
  wApp.Visible = True
  Dim x               As Long
  Dim LastRow         As Long
  Dim SheetChart      As String
  Dim SheetRange      As String
  Dim BookMarkChart   As String
  Dim BookMarkRange   As String
  Dim Prompt          As String
  Dim Title           As String
  
  'Turn some stuff off while the macro is running
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  
  'Determine the last row of data for our loop
  LastRow = Sheets("Bookmarks").Range("A" &amp; Rows.Count).End(xlUp).Row
  
  'Create an instance of Word for us to use
  Set wApp = CreateObject("Word.Application")
  
  'Open our specified Word file, On Error is used in case the file is not there
  On Error Resume Next
  Set wDoc = wApp.Documents.Open("C:\Users\USER\Documents\Custom Office Templates\Test161231.dotm", ReadOnly:=True)
  On Error GoTo 0
  
  'If the file is not found, we need to end the sub and let the user know
  If wDoc Is Nothing Then
      MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
      wApp.Quit
      Set wApp = Nothing
      Exit Sub
  End If
  
  'Copy/Paste Loop starts here
  For x = 2 To 20
  
  'Use the Status Bar to let the user know what the current progress is
  Prompt = "Copying Data: " &amp; x - 1 &amp; " of " &amp; LastRow - 1 &amp; "   (" &amp; _
      Format((x - 1) / (LastRow - 1), "Percent") &amp; ")"
  Application.StatusBar = Prompt
  
  'Assign the worksheet names and bookmark names to a variable
  'Use With to group these lines together
  With ThisWorkbook.Sheets("Bookmarks")
      SheetChart = .Range("A" &amp; x).Text
      SheetRange = .Range("B" &amp; x).Text
      BookMarkChart = .Range("C" &amp; x).Text
      BookMarkRange = .Range("D" &amp; x).Text
  
  End With
  
  If Len(BookMarkRange) &gt; 0 Then
  'Tell Word to goto the bookmark assigned to the variable BookMarkRange
  wApp.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkRange
  
  'Copy the data from Thisworkbook
  ThisWorkbook.Sheets(SheetRange).UsedRange.Copy
  
  'Paste into Word
  wApp.Selection.Paste
  
  'Autofit Table so it fits inside Word Document window
  '?
  
  End If
  
  If Len(BookMarkChart) &gt; 0 Then
  'Tell Word to goto the bookmark assigned to the variable BookMarkChart
  wApp.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkChart
  
     'Copy the data from Thisworkbook
  ThisWorkbook.Sheets(SheetChart).ChartObjects(1).Copy
  
  'Paste into Word
  wApp.Selection.Paste
  
  'Autofit Chart so it fits inside Word Document window
  '?
  
  End If
  
  Next
  
  'Turn everything back on
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True
  Application.StatusBar = False
  
  'Let the user know the procedure is now complete
  Prompt = "Your report has now been generated." &amp; vbCrLf &amp; vbCrLf &amp; "You may now edit the word document."
  Title = "Procedure Completion"
  MsgBox Prompt, vbOKOnly + vbInformation, Title
  
  'Make our Word session visible
  wApp.Visible = True
  
  With wDoc
  
  .SaveAs ActiveWorkbook.Path &amp; Application.PathSeparator &amp; "Test3_" &amp; Format(Now, "yyyy-mm-dd hh-mm") &amp; ".docx", FileFormat:=wdFormatXMLDocument
  wApp.DisplayAlerts = True
  
  End With
  
  'Clean up
  Set wApp = Nothing
  Set wDoc = Nothing
  
  End Sub
  </code></pre>
  
  <p>Any help and other useful comments would be greatly appreciated! I'm still in the early learning phase.</p>