InlineShapes.AddOLEObject без открытия пользовательского интерфейса MSWord

Question

Я пытаюсь использовать VBA для добавления встроенного OLE (пустой документ MSWord, значок: = True) из открытого документа MSWord без открытия пользовательского интерфейса для вновь созданного пустого документа MSWord). Следующий VBA заменяет второй абзац в текущем документе значком MSWord OLE, но открывает документ значка MSWord в собственном окне.

Sub InsertOLEobject()
    ActiveDocument.InlineShapes.AddOLEObject _
    ClassType:="Word.Document", DisplayAsIcon:=True, _
    Range:=ActiveDocument.Paragraphs(2).Range 'Replaces the second paragraph with the MSWord Icon
End Sub

Кто-нибудь может дать мне совет?

Ниже приведен последний код VBA для того, что я хотел сделать. InlineShapes.AddOLEObject не откроет пользовательский интерфейс Word, если вы используете существующий файл. Я просто надеялся на более элегантный способ без создания файла, который нужно удалить.

Sub InsertOLEobject()
    Dim docNewBlank As Document
    Set docNewBlank = Documents.Add
    Set DocA = ActiveDocument
    With docNewBlank
        'Centering the paragraph within the blank document
        .Paragraphs(1).Alignment = wdAlignParagraphCenter
        'Saved the file to a temporary scratch location
        .SaveAs FileName:="c:\temp\Blank.doc"
        .Close 'Close the word document
    End With

    'Add the embedded MSWord OLE Icon
    ActiveDocument.InlineShapes.AddOLEObject _
        ClassType:="Word.Document", _
        FileName:="c:\Temp\Blank.doc", _
        DisplayAsIcon:=True, _
        IconLabel:="Blank.doc", _
        IconFileName:="WINWORD.EXE", _
        Range:=ActiveDocument.Paragraphs(2).Range
        'Set the filename of your choice
        'Set the Range to the destination of the ole icon
        'Set the icon to the path of your WINWORD.EXE
End Sub

Answer 1

Окончательным решением было добавить «ActiveWindow.Close» после вставки значка Word OLE с пустым именем; это закрывает окно, только что открытое «ActiveDocument.InlineShapes.AddOLEObject». Поэтому мне не нужно было сначала создавать blank.do c; поэтому я удалил этот код VBA.

Меня спросили, какова моя цель в этом проекте; моей целью было вырезать таблицы и изображения в документе и вставить их на место в значки объектов Word OLE. Результирующий текстовый файл со всеми изображениями и таблицами, инкапсулированными в значки объектов Word OLE, может использоваться в качестве входных данных для надстройки экспорта Rational DOORS (DOORS). Я мог бы напрямую экспортировать изображения и таблицы в DOORS, чтобы их можно было просматривать в DOORS, но если вы когда-нибудь дважды щелкнули изображение или таблицу в DOORS, вы бы обнаружили, что объект OLE открывается внутри ячейки и его очень трудно редактировать, изменить размер или положение. Я отделил табличную функцию от подпрограммы inlineshapes; мой код VBA выглядит следующим образом:

'================================================================================
' Cut all Tables and paste them into Word OLE Icons
'================================================================================
Sub IconizeInlineTables()
'================================================================================
Dim iTable As Table
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim DocA As Document
Dim DocC As Document
Set DocA = ActiveDocument

For Each iTable In DocA.Tables
    Set RngA = iTable.Range 'Go to the start of the table
    RngA.Expand Unit:=wdTable
    Set RngB = RngA.Duplicate 'Duplicate the range to keep track of table location
    RngB.Collapse Direction:=wdCollapseEnd 'Collapse the Duplicate range to the point after the Table
    RngA.Select

    'MsgBox "Tables Left to Process =" & DocA.Tables.Count

    Selection.Cut 'Cut the Table and put it in the paste buffer

    'Insert the MSWord.doc OLE icon

    ActiveDocument.InlineShapes.AddOLEObject _
        ClassType:="Word.Document", _
        FileName:="", _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="WINWORD.EXE", _
        IconLabel:="Table-" & iTableCount & ".doc", _
        Range:=RngB
    ActiveWindow.Close

    'Expand the range to include the OLE icon then select the new range

    With RngB
        .Expand Unit:=wdParagraph
        .Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
        .Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
        .InlineShapes(1).Select 'Select the inlineshape containing the OLE
    End With

    'Make sure that the InlineShape is the OLE icon

    If InStr(1, RngB.InlineShapes(1).OLEFormat.ProgID, "Word.Document.", vbTextCompare) Then
        Set DocC = RngB.InlineShapes(1).OLEFormat.Object 'Select the OLE Object
        Set RngC = DocC.Paragraphs(1).Range 'Select the first Paragraph within the OLE Object
        With RngC
            .Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
            .Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
            .Collapse Direction:=wdCollapseEnd 'Collapse to just beyond end of paragraph
            .MoveEnd Unit:=wdCharacter, Count:=-1 'Back the RngC up one character to not include the paragraph marker
            .Select
            .Paste 'Paste the Table cut with RngA.cut here
        End With
    Else 'Something I did not expect happened
        MsgBox "Error: " & Selection.InlineShapes(1).OLEFormat.ProgID & "Not Expected"
    End If
Next
End Sub

'================================================================================
' Cut all Figures and paste them into Word OLE Icons
'================================================================================
Sub IconizeInlineShapes()
'================================================================================
Dim iShape As InlineShape
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim DocA As Document
Dim DocC As Document
Set DocA = ActiveDocument

Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst 'Start at the beginning of the document

For Each iShape In DocA.InlineShapes
    If iShape.Type = wdInlineShapePicture Then
        Set RngA = iShape.Range 'Set the range to the image
        Set RngB = RngA.Duplicate 'Duplicate the range to keep track of location
        RngB.Collapse Direction:=wdCollapseEnd 'Collapses to the end of the selection
        RngA.Select
        Selection.Cut 'Cut the image and put it in the paste buffer
       'Insert the MSWord OLE icon
        ActiveDocument.InlineShapes.AddOLEObject _
            ClassType:="Word.Document", _
            FileName:="", _
            LinkToFile:=False, _
            DisplayAsIcon:=True, _
            IconFileName:="WINWORD.EXE", _
            IconLabel:="Figure-" & DocA.InlineShapes.Count & ".doc", _
            Range:=RngB
        ActiveWindow.Close

        'The inserted OLE is the next InlineShape to be found so you don't have to select it just loop around to next iShape

    ElseIf InStr(1, iShape.OLEFormat.ProgID, "Word.Document.", vbTextCompare) Then 'Make sure iShape OLE object was next
        Set DocC = iShape.OLEFormat.Object 'Select the OLE object
        Set RngC = DocC.Paragraphs(1).Range 'Select the first Paragraph within the OLE Object
        RngC.Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
        RngC.Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
        RngC.Collapse Direction:=wdCollapseEnd 'Collapse to just beyond end of paragraph
        RngC.MoveEnd Unit:=wdCharacter, Count:=-1 'Back the RngC up one character to not include the paragraph marker
        RngC.Select
        RngC.Paste 'Paste the image cut with RngA.cut here
    Else 'Something I did not expect happened
        MsgBox "Warning: " & iShape.OLEFormat.ProgID & "Not handled by this software"
    End If
Next
End Sub

Обратите внимание, что «IconFileName: =« WINWORD.EXE »является общим c, но, возможно, его придется изменить для вашей конкретной установки.

Answer 2

FWIW Я не уверен, что точно следил за тем, что вы пытаетесь сделать, но мне интересно, будет ли это делать то, что вам нужно (за исключением того, что документ не совсем пустой и будет .docx, а не .do c):

Sub embedNearlyEmptyWordDoc()
Dim appFullName As String
' Windows only, perhaps there is a better place to get this string
appFullName = Application.Path & Application.PathSeparator & "winword.exe"
With ActiveDocument
' insert a space somewhere "safe" (not necessarily where I have put it
  .Range(0, 0).Text = " "
  .Range(0, 1).Copy
  .Range(0, 0).Text = ""
End With
' Alter this to put the doc where you want
ActiveDocument.Paragraphs(2).Range.PasteSpecial IconIndex:=0, Link:=False, Placement:=wdInLine, DisplayAsIcon:=True, DataType:=wdPasteOLEObject, IconFileName:=appFullName, IconLabel:="Blank.docx"
End Sub