none
Embedded object RRS feed

  • Question

  • We have excel protected sheet with embedded object - ms word. Small change in embedded MS word is OK. If we add a lot of text, the MS word decrease font and text is unreadable. The property of embedded object is set on "Move and size with cells". We need resize excel row with embedded object depend on the content in MS word. We try use macros, but the property Height is height of object, and is not depend on count of rows in ms word.

    Is it possible dynamically resize embedded object depend on content ms word?

    Thanks

    Monday, December 5, 2016 11:39 AM

All replies

  • I have solved this by unchecking the "Lock Aspect Ratio".

    To get to this setting, right-click on the window containing the word object, select "Format Object..."

    Click on the "Size" tab,

    Uncheck the "Lock Aspect Ratio".

    I have kept the embedded object as "Move but don't size with cells", though the behavior of Lock aspect ratio will cause the embedded shape (MS word box) to re-size.


    **** edit ***
    I'd forgotten that just changing the "Lock Aspect Ratio" will auto-size the box, to either locked or unlocked.
    **** edit ***
    • Edited by MainSleuth Monday, December 5, 2016 4:35 PM More info
    Monday, December 5, 2016 3:42 PM
  • A little further discussion and access to the various properties may also be helpful. By the way, I assume you have either the 'Locked' property of the embedded object unchecked and/or the 'edit objects' property of the worksheet protections checked, since you can edit the Word Document.

    The following code will give you access to many of the properties necessary to resize. Of course, you will need to set a reference to the Microsoft Word Object Library:

    Option Explicit
    Option Base 0
    Option Compare Text
    
    
    Public Sub AccessingShapeProperties()
        ' Note: Tools/References must have a Microsoft Word object Library selected
        Const conLngPtsPerInch As Long = 72
        Dim wksThis As Worksheet
        Dim spThis As Excel.Shape
        Dim srngThis As Excel.ShapeRange
        Dim oThisShapeFormat As Excel.OLEFormat
        Dim oWordDocInShape As Word.Document
        
        On Error Resume Next
    ' ** acquire the Worksheet
        Set wksThis = Excel.ThisWorkbook.ActiveSheet
        If wksThis.Shapes.Count > 0 Then
    ' ** acquire each Shape in the worksheet
            For Each spThis In wksThis.Shapes
                    MsgBox spThis.Name & " is " & spThis.OLEFormat.progID
    ' ** acquire a ShapeRange (collection) to which this shape is assigned
                Set srngThis = wksThis.Shapes.Range(Array(spThis.Name))
                If Not srngThis Is Nothing Then
                    'Access to shaperange properties & methods. e.g.: srngThis.LockAspectRatio = Not srngThis.LockAspectRatio
                    srngThis.LockAspectRatio = Not srngThis.LockAspectRatio
                    MsgBox "Box Height" & srngThis.Height / conLngPtsPerInch & " (ins.), Width" & srngThis.Width / conLngPtsPerInch & " (ins.)"
                End If
                'access to shape type specific properties:
                ' ref: https://msdn.microsoft.com/en-us/library/office/ff822186.aspx
                Select Case spThis.Type
                    Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoOLEControlObject, msoLinkedPicture, msoPicture
                        spThis.ScaleHeight 1, msoTrue
                        spThis.ScaleWidth 1, msoTrue
    ' ** acquire the OleFormatObject
                        Set oThisShapeFormat = spThis.OLEFormat         ' use this to access the actual Word Document.
                        If Not oThisShapeFormat Is Nothing Then
                            MsgBox "OleFormat Object Height" & oThisShapeFormat.Object.Height / conLngPtsPerInch & " (ins.), Width" & oThisShapeFormat.Object.Width / conLngPtsPerInch & " (ins.)"
                            If InStr(oThisShapeFormat.progID, "Word.") > 0 Then
                                oThisShapeFormat.Activate               ' Puts the focus on the correct word document
    ' ** acquire the Word Document
                                Set oWordDocInShape = oThisShapeFormat.Object.Object
                                If Not oWordDocInShape Is Nothing Then
                                    MsgBox spThis.Name & " contains a document of " & wdLineCount(oWordDocInShape, True) & " lines."
                                End If
                            End If
                        End If
                    Case Else
                        spThis.ScaleHeight 1, msoFalse
                        spThis.ScaleWidth 1, msoFalse
                End Select
                wksThis.Range("A1").Activate        ' Puts the focus back to Excel
                Set oWordDocInShape = Nothing
                Set oThisShapeFormat = Nothing
                Set srngThis = Nothing
            Next spThis
        Else
            MsgBox "No Shapes on """ & wksThis.Name & """."
        End If
        Set oWordDocInShape = Nothing
        Set oThisShapeFormat = Nothing
        Set srngThis = Nothing
        Set spThis = Nothing
        Set wksThis = Nothing
    End Sub
    
    Private Function wdLineCount(wdInDocument As Word.Document, Optional boolFullDocument As Boolean = True) As Long
         ' Note: Tools/References must have a Microsoft Word object Library selected
         'ref: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/word-vba-code-to-get-number-of-liness-in-a/fd0bc291-0e5b-49b1-8ed7-d6418b8f4c0b
         wdLineCount = 0
         On Error Resume Next
         If boolFullDocument Then wdInDocument.Range.WholeStory
         With Dialogs(wdDialogToolsWordCount)
             .Execute
             wdLineCount = .lines
         End With
     End Function

    Monday, December 5, 2016 6:06 PM
  • Hi JanLos,

    first I want to confirm with you regarding embedded object.

    if you try to embed the document it will show the first page of the document.

    so is your object size is small then a page?

    did you try to reset the size?

    what did you try by code? if possible then try to share with us.

    so that we can try to test it on our side.

    this is the forum for development issue so here you will only get development related suggestions.

    you can try the below code which will set the size of full page. so it will display the content properly in the object.

    Sub Test()
    Dim OleObj As OLEObject
    
        Set OleObj = ActiveSheet.OLEObjects(1)
        OleObj.ShapeRange.LockAspectRatio = msoFalse
        OleObj.Height = 650
        OleObj.Width = 470
    
    End Sub
    

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Tuesday, December 6, 2016 2:02 AM
    Moderator