Runtime error 462 Excel VBA using Word

问题

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.

The error takes place in the .Height = InchesToPoints(6.1) line.

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

回答1:

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

回答2:

Definitly too much With, and not even used, so here is a version of your resize that should be cleaner but not sure that it'll be enough, give it a try

Too many WDApp.Visible = True also, only one will be enough but as you close it after, you should even set it to 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

来源：https://stackoverflow.com/questions/29687724/runtime-error-462-excel-vba-using-word

标签

excel

vba

excel-vba

ms-word