Question

第二次或第三次运行此循环时，我一直收到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

Answer 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

Answer 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

运行时错误462使用Word的Excel VBA

2 个答案: