Vba不识别OLE对象

Question

大家好！所有程序员都很棒！

任何人都可以向我解释我是如何解决这个问题的吗？ 它在excel 2003中运行良好，但在2010年我收到了这个错误：

有人可以指导我朝正确的方向发展吗？ 应该做什么尺度高度，确保复制到单词对象中的所有文本都是可见的 - 如果我将scaleheight设置为1，则msoFalse不是这种情况。

您应该能够将代码粘贴到新的子代码中。

Sub Embed_WordDocument_To_sheet()

Dim oWD As Document ' Word Document Object (Use Microsoft Word Reference)

Set ws = Worksheets.Add
Set wsFactark = Worksheets("Sheet1")

ws.Range("C3").Select

Set oOLEWd = ws.OLEObjects.Add( _
    ClassType:="Word.Document", _
    Width:=375)

oOLEWd.Name = "EmbeddedWordDoc"
oOLEWd.ShapeRange.LockAspectRatio = msoFalse
oOLEWd.Width = 375
oOLEWd.Height = 10 ' bliver ligegyldig når du har gjort det som står i nederste kommentar.
oOLEWd.Top = ws.Range("C3").Top + 2 ' +2 for ikke at overstrege border-linjen
oOLEWd.Left = ws.Range("C3").Left + 5 ' samme

' PROBLEM - "The relativetooriginalsize argument applies only to a picture or an OLE object." !!!
oOLEWd.ShapeRange.ScaleHeight 1, msoTrue ' msoFalse works, msoCTrue doesn't

oOLEWd.Placement = xlFreeFloating

' Assign the OLE Object to Word Object
Set oWD = oOLEWd.Object
wsFactark.Cells(I + 4, 13).Copy

oWD.Paragraphs(oWD.Paragraphs.Count).Range.PasteAndFormat (wdFormatOriginalFormatting)

With oWD.PageSetup
.TopMargin = 0
.BottomMargin = 0
.LeftMargin = 0
.RightMargin = 0
    .PageHeight = 1584 'max
    .PageWidth = 1584
End With

oOLEWd.Activate

oOLEWd.Height = selection.Application.UsableHeight

oOLEWd.ShapeRange.Line.Visible = msoFalse

If oOLEWd.Height > 400 And oOLEWd.Height < 800 Then
    ws.Range("B3").RowHeight = 400
    ws.Range("B4").RowHeight = oOLEWd.Height - 400 + 20
ElseIf oOLEWd.Height > 800 And oOLEWd.Height < 1000 Then
    ws.Range("B3").RowHeight = 400
    ws.Range("B4").RowHeight = 200
    ws.Range("B5").RowHeight = 200
    ws.Range("B7").RowHeight = oOLEWd.Height - 800 + 20
ElseIf oOLEWd.Height > 1000 And oOLEWd.Height < 1200 Then
    ws.Range("B3").RowHeight = 400
    ws.Range("B4").RowHeight = 200
    ws.Range("B5").RowHeight = 200
    ws.Range("B6").RowHeight = 200
    ws.Range("B7").RowHeight = 200
    ws.Range("B9").RowHeight = oOLEWd.Height - 1000 + 20
Else
    ws.Range("B3").RowHeight = oOLEWd.Height
    ws.Range("B4:B11").RowHeight = 0
End If
    ws.Range("B12").RowHeight = 10

Range("A1").Select

End Sub

Answer 1

这可能会起作用（至少在我的系统上 - Excel 2010）：

Sub M_snb()
  ActiveSheet.OLEObjects.Add , "G:\example.docx", True, False, , , , Columns(3).Left, Rows(3).Top
End Sub

将Word文档另存为PDF：

Sub M_snb()
 Sheet1.Range("A1:G7").Copy

 With CreateObject("Word.document")
  .Windows(1).Visible = True
  .Content.Paste
  .ExportAsFixedFormat "G:\OF\new.pdf", 17
  .Close -1
 End With
End Sub