运行时错误462 Excel VBA使用Word

运行时错误462 Excel VBA使用Word,vba,excel,ms-word,Vba,Excel,Ms Word,在第二次或第三次运行此循环时,我不断收到462错误。我不认为我有任何漂浮的物体,但也许我错过了什么,我在这方面是新的。此宏从Excel中获取所有图表,将它们粘贴到Word中作为图片,调整它们的大小,保存文档并将其关闭。For循环具有将图表粘贴为普通图片的格式,并将其下方的文本作为标题,因此我可以轻松创建一个图形表 错误发生在.Height=InchesToPoints(6.1)行中 Private Sub ChartstoWord_Click() Dim WDApp As Word.Appli

在第二次或第三次运行此循环时,我不断收到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

使用的
太多了,甚至没有使用,所以这里有一个版本的调整大小,应该更干净,但不确定是否足够,试试看

太多的
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

我能够解决这个问题,结果是InchesToPoints中的命令是一个word命令,需要前面有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

为什么在您没有使用
.WDApp
.WDDoc
语句的情况下,这三个
语句都在导致错误的行中,而不是显式使用它,例如
WDApp.ActiveDocument.InlineShapes.Count
?为什么不使用
.InlineShapes.Count
语句设置
?多个
with
语句的歧义是否会导致此错误?这是您应该尝试调试的地方。。。使用类似于
Debug.Print WDDoc.InlineShapes(i).Name
的东西,或者设置一个断点并使用本地窗口查看发生了什么。非常感谢您发布Avnee,克服了很多心痛,因为这是一个没有明显原因的偶发问题。我想这世界上的每一样东西都要用一个对象引用。连这个命令都不知道。但我学到了很多。非常感谢。