【问题标题】:Runtime error 462 Excel VBA using Word运行时错误 462 Excel VBA 使用 Word
【发布时间】:2015-06-23 15:03:20
【问题描述】:

我在第二次或第三次运行此循环时不断收到 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.WDDoc 时,为什么你在一行周围有三个 With 语句导致错误 - 而是明确使用它,例如WDApp.ActiveDocument.InlineShapes.Count?为什么不使用.InlineShapes.CountFor 语句?多个With 语句的歧义是否会导致此错误?
  • 这是您应该尝试调试的地方...使用Debug.Print WDDoc.InlineShapes(i).Name 之类的内容或设置断点并使用“本地”窗口查看发生了什么。

标签: vba excel ms-word


【解决方案1】:

我能够解决问题,最终是命令 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

【讨论】:

  • 非常感谢您发布 Avnee,克服了很多心痛,因为这是一个没有明显原因的零星问题。我猜必须使用对象引用来使用世界上的所有东西。没想到连这个命令都是这样的。但是学到了很多。非常感谢。
【解决方案2】:

确实太多了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

【讨论】:

    猜你喜欢
    • 2023-01-29
    • 2020-03-18
    • 1970-01-01
    • 2019-03-29
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-11-16
    • 1970-01-01
    相关资源
    最近更新 更多