运行时错误 462 Excel VBA 使用 Word [英] Runtime error 462 Excel VBA using Word

问题描述

我在第二次或第三次运行此循环时不断收到 462 错误.我不认为我有任何漂浮的物体，但也许我错过了一些东西，我对此有点陌生.这个宏从 Excel 中获取所有图表，将它们作为图片粘贴到 Word 中，调整它们的大小，保存文档并关闭它.For 循环具有将图表粘贴为普通图片的格式，并将其下方的文本作为标题，因此我可以轻松创建图表表格.

I keep getting the 462 error the second or third time I run this loop. I don't think I have any objects that are floating but maybe I missed something, I am kind of new at this. This macro is taking all the charts from Excel, pasting them into Word as pictures, resizing them, saving the document and closing it. The For loop has formatting for the chart to be pasted as a normal picture and the text below it to be caption so I can create a figure table easily.

错误发生在 .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

推荐答案

我解决了这个问题，结果是命令 InchesToPoints 是一个单词命令，需要在它前面加上 wdapp.感谢您的所有建议，在您提出所有建议后，我还清理了一些代码.

I was able to solve the problem, ended up being that the command InchesToPoints is a word command and needs the wdapp in front of it. Thanks for all the suggestions, I also cleaned up a code a bit after all your receommendations.

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

这篇关于运行时错误 462 Excel VBA 使用 Word的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！