Excel VBA - 複数のチャートと表をブックマークの単語に自動フィッティングしますか？

Question

私は定義されたブックマークで複数のチャットとテーブルを単語に貼り付けるときに、私のサブメニューにAutofitを追加するのに苦労しています。私は複数の方法を試しましたが、私の経験不足は見せていますし、サブはautofitを追加/混乱させると失敗するかautofitしません。

それは以下の立つようそれが正常に動作：

'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" & 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: " & x - 1 & " of " & LastRow - 1 & " (" & _ 
    Format((x - 1)/(LastRow - 1), "Percent") & ")" 
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" & x).Text 
    SheetRange = .Range("B" & x).Text 
    BookMarkChart = .Range("C" & x).Text 
    BookMarkRange = .Range("D" & x).Text 

End With 

If Len(BookMarkRange) > 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) > 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." & vbCrLf & vbCrLf & "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 & Application.PathSeparator & "Test3_" & Format(Now, "yyyy-mm-dd hh-mm") & ".docx", FileFormat:=wdFormatXMLDocument 
wApp.DisplayAlerts = True 

End With 

'Clean up 
Set wApp = Nothing 
Set wDoc = Nothing 

End Sub 

すべてのヘルプやその他の有益なコメントをいただければ幸いです！私はまだ早い学習段階にあります。

Answer 1

私はすぐに次見つけることができる：

1. あなたのコードがExit Subで停止したときにあなたが二回（変数宣言中およびLastRow = Sheets("Bookmarks").Range("A" & Rows.Count).End(xlUp).Row後）
2. Set wApp = CreateObject("Word.Application")を使用する（あなたは「いくつかのものを」回すことに注意してくださいScreenUpdating、アラート、イベント）背中に（参照：If wDoc Is Nothing Then）
3. あなたのループFor x = 2 To 20を開始するが、あなたは決して本当にループ（なしnext x）
4. 私はyの推測oループ中にLastRowの結果を使用したい（For x = 2 To LastRow）。自動調整の試みのために
： Dim WordTable As Word.Table、 Set WordTable = myDoc.Tables(1)、 WordTable.AutoFitBehavior (wdAutoFitWindow)