[英]Runtime error 462 Excel VBA using Word
I keep getting the 462 error the second or third time I run this loop. 第二次或第三次运行此循环时,我不断收到462错误。 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.
此宏从Excel中获取所有图表,将它们作为图片粘贴到Word中,调整它们的大小,保存文档并关闭它。 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.
For循环具有将图表粘贴为普通图片的格式,而在其下方的文本则作为标题,因此我可以轻松地创建图表。
The error takes place in the .Height = InchesToPoints(6.1)
line. 该错误发生在
.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
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. 我能够解决问题,最终是命令InchesToPoints是一个单词命令,并且需要在其前面加上wdapp。 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
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 Definitly太多
With
,甚至不使用,所以这里是你的大小调整的一个版本,应该是清洁,但不能肯定这将是足够的,不妨一试
Too many WDApp.Visible = True
also, only one will be enough but as you close it after, you should even set it to False! 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.