運行時錯誤462使用Word的Excel VBA

Question

我在第二次或第三次運行此循環時不斷收到462錯誤。我不認爲我有任何漂浮的物體，但也許我錯過了一些東西，我對此很感興趣。該宏從Excel中獲取所有圖表，將它們粘貼到Word中作爲圖片，調整它們大小，保存文檔並關閉它。 For循環具有用於將圖表格式化爲普通圖片並將其下面的文本作爲標題的格式，以便我可以輕鬆創建圖表。

錯誤發生在.Height = InchesToPoints(6.1)行。

Private Sub ChartstoWord_Click() 

Dim WDApp As Word.Application 
Dim WDDoc As Word.Document 
Dim cname, wordname, restage, pNumber, wfile As String 
Dim n As Integer 
Dim i As Long 


Application.ScreenUpdating = False 

If wordfile.Value = "" Then 
    MsgBox "Please enter a word file name", vbOKOnly 
    Exit Sub 
End If 

wfile = CurveDirectoryBox & "\" & wordfile.Value & ".docx" 
wordname = UCase(dataname.Value) 

'if word file doesn't exist then it makes the word file for you 
If Dir(wfile) = "" Then 
    Set WDApp = CreateObject("Word.application") 
    WDApp.Visible = True 
    Set WDDoc = WDApp.Documents.Add 
    WDApp.Visible = True 
    With WDDoc 
     .SaveAs wfile 
     .Close 
    End With 
    Set WDDoc = Nothing 
    WDApp.Quit 
    Set WDApp = Nothing 
End If 

' Create new instance of Word and open filename provided if file exists 
Set WDApp = CreateObject("Word.application") 
WDApp.Visible = True 
WDApp.Documents.Open wfile 
WDApp.Visible = True 

Set WDDoc = WDApp.ActiveDocument 

With WDDoc 
    .Range(start:=.Range.End - 1, End:=.Range.End - 1).Select 
    .PageSetup.Orientation = wdOrientLandscape 
End With 

For n = 1 To Charts.Count 

Charts(n).Select 
cname = ActiveChart.ChartTitle.Characters.Text 
ActiveChart.CopyPicture _ 
    Appearance:=xlScreen, Format:=xlPicture 

' Paste chart at end of current document 

WDApp.Visible = True 

With WDApp 

.Selection.Style = WDApp.ActiveDocument.Styles("Normal") 
.Selection.Font.Size = 12 
.Selection.Font.Bold = True 
.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False, DataType:=wdPasteEnhancedMetafile 
.Selection.TypeParagraph 
.Selection.Style = WDApp.ActiveDocument.Styles("Caption") 
.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 
.Selection.Font.Size = 12 
.Selection.Font.Bold = False 
.Selection.TypeText (wordname + " " + cname) 
.Selection.TypeParagraph 

End With 

Next n 

'resize all pictures 
WDApp.Visible = True 
With WDApp 

With WDDoc 
    For i = 1 To WDApp.ActiveDocument.InlineShapes.Count 
     With WDApp.ActiveDocument.InlineShapes(i) 
      '.Width = InchesToPoints(7.9) 
      .Height = InchesToPoints(6.1) 
     End With 
    Next i 
End With 
End With 

WDDoc.Save 
WDDoc.Close 
Set WDDoc = Nothing 

WDApp.Quit 
Set WDApp = Nothing 

Worksheets("Control").Activate 
Range("A1").Select 

Application.ScreenUpdating = True 
End Sub 

Answer 1

Definitly太多With，甚至不使用，所以這裏是你的大小調整的一個版本，應該是清潔，但不能肯定這將是足夠的，試試看

太多WDApp.Visible = True同樣，只有一個就足夠了，但是當你關閉它之後，你甚至應該把它設置爲False！

'resize all pictures 
For i = 1 To WDDoc.InlineShapes.Count 
    With WDDoc.InlineShapes(i) 
     '.Width = InchesToPoints(7.9) 
     .Height = InchesToPoints(6.1) 
    End With 
Next i 

Answer 2

我能夠解決這個問題，結果是命令InchesToPoints是一個字命令，需要在它前面的wdapp。感謝所有的建議，我在所有推薦之後還清理了一段代碼。

Private Sub ChartstoWord_Click() 

Dim WDApp As Word.Application 
Dim cname, wordname, restage, pNumber, wfile As String 
Dim n As Integer 
Dim i, h As Long 


Application.ScreenUpdating = False 

If wordfile.Value = "" Then 
    MsgBox "Please enter a word file name", vbOKOnly 
    Exit Sub 
End If 

wfile = CurveDirectoryBox & "\" & wordfile.Value & ".docx" 
wordname = UCase(dataname.Value) 

'if word file doesn't exist then it makes the word file for you 
If Dir(wfile) = "" Then 
    Set WDApp = CreateObject("Word.application") 
    WDApp.Visible = True 
    WDApp.Documents.Add 
    WDApp.ActiveDocument.SaveAs wfile 
    WDApp.ActiveDocument.Close 
    WDApp.Quit 
    Set WDApp = Nothing 
End If 

' Create new instance of Word and open filename provided if file exists, checks to see if file is open or not already 
If IsFileOpen(wfile) = False Then 

    Set WDApp = CreateObject("Word.application") 
    WDApp.Visible = True 
    WDApp.Documents.Open wfile 
End If 

If IsFileOpen(wfile) = True Then 

    Set WDApp = GetObject(wfile).Application 
    WDApp.Visible = True 

End If 


'moves cursor in word to the end of the document and change page to landscape 
WDApp.ActiveDocument.Range(start:=WDApp.ActiveDocument.Range.End - 1, End:=WDApp.ActiveDocument.Range.End - 1).Select 
WDApp.ActiveDocument.PageSetup.Orientation = wdOrientLandscape 



'loops through all charts and pastes them in word 
For n = 1 To Charts.Count 

Charts(n).Select 
cname = ActiveChart.ChartTitle.Characters.Text 
ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

WDApp.Visible = True 

WDApp.Selection.Style = WDApp.ActiveDocument.Styles("Normal") 
WDApp.Selection.Font.Size = 12 
WDApp.Selection.Font.Bold = True 
WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False, DataType:=wdPasteEnhancedMetafile 
WDApp.Selection.TypeParagraph 
WDApp.Selection.Style = WDApp.ActiveDocument.Styles("Caption") 
WDApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 
WDApp.Selection.Font.Size = 12 
WDApp.Selection.Font.Bold = False 
WDApp.Selection.TypeText (wordname + " " + cname) 
WDApp.Selection.TypeParagraph 

Next n 

'resize all pictures 
WDApp.Visible = True 
For i = 1 To WDApp.ActiveDocument.InlineShapes.Count 

    WDApp.ActiveDocument.InlineShapes(i).Select 
    WDApp.ActiveDocument.InlineShapes(i).Height = WDApp.InchesToPoints(6.1) 

Next i 

WDApp.ActiveDocument.SaveAs wfile 
WDApp.ActiveDocument.Close 
WDApp.Quit 
Set WDApp = Nothing 

Worksheets("Control").Activate 
Range("A1").Select 

Application.ScreenUpdating = True 
End Sub