Search code examples
vbams-wordshapesrichtext

VBA - How to access "TextFrame2" property?


Consider that our VBA script programmatically does create a text-box Shape, which then contains an image of Inline-Shape kind, and store said text-box into the myShape variable, like below:

Private Sub addImageButton_Click()

Dim doc As Document: Set doc = ThisDocument
Dim myShape As Word.Shape
Dim imageShape As Word.InlineShape
Const Width As Single = 147.75
Const Height As Single = 132.3

Dim filePath$: filePath = "C:\test.jpg"
If IsEmpty(filePath) Or Not IsFile(filePath) Then
    Exit Sub
End If

' Set cursor position where we want the text-box
'
addImageButton.Select
Selection.MoveDown Unit:=wdParagraph, Count:=1

' Place the text-box shape at the current cursor position
'   plus 1 down in vertical direction to prevent automatic moving to the previous paragraph during 'inlining'
Set myShape = doc.Shapes.AddTextbox(msoTextOrientationHorizontal _
        , Selection.Information(wdHorizontalPositionRelativeToPage) _
        , Selection.Information(wdVerticalPositionRelativeToPage) + 1 _
        , Width, Height _
    )
With myShape
    .Line.Visible = msoFalse ' hides border
    .LockAspectRatio = msoTrue
    With .Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.8000000119
        .Transparency = 0
        .Solid
    End With
    With .TextFrame
        .MarginLeft = 0
        .MarginRight = 0
        .MarginTop = 0
        .MarginBottom = 0
        .AutoSize = msoAutoSizeShapeToFitText
    End With
    With .TextFrame.TextRange
        .Text = Chr(13) & "NEW-TITLE" & Chr(13) _
            & "DESCRIPTION"
        Set imageShape = .InlineShapes.AddPicture(FileName:=filePath _
                , LinkToFile:=msoFalse, SaveWithDocument:=True)
        With imageShape
            .LockAspectRatio = msoTrue
            .Width = Width
        End With
    End With
End With

End Sub

Public Function IsFile(ByVal path As String) As Boolean
' Returns TRUE if the provided name points to an existing file.
' Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(path) And vbDirectory) <> vbDirectory)
End Function

Why would we get "The specified value is out of range." error, whenever we try to access the myShape.TextFrame2 property, or even using Selection like below:

myShape.Select
Selection.ShapeRange.LockAspectRatio = msoTrue
' Below will give an error!
Selection.ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText 

Note: I am trying to give the text specific formatting, like for example making the "NEW-TITLE" part of the text bold while keeping the remaining text as is.


Solution

  • Does this help:

        With .TextFrame.TextRange
                .Text = Chr(13) & "NEW-TITLE" & Chr(13) _
                    & "DESCRIPTION"
    
    '--------------------------------------
                    .Characters(4).Font.Bold = msoTrue ' which is the W
                    .Characters(3).Font.ColorIndex = wdBlue 'which is the first E
    '---------------------------------------------------------
                          Set imageShape = .InlineShapes.AddPicture(FileName:=filePath _
                        , LinkToFile:=msoFalse, SaveWithDocument:=True)
                With imageShape
                    .LockAspectRatio = msoTrue
                    .Width = Width
                End With
            End With
    

    Example:

    Below is what worked for the OP, which as suggested in the comments makes use of Shape.TextFrame.TextRange.Sentences(index As Long) As Range to change paragraph specific font settings:

    Private Sub addImageButton_Click()
    
    Dim doc As Document: Set doc = ThisDocument
    Dim filePath$
    Dim myShape As Word.Shape
    Dim imageShape As Word.InlineShape
    Const Width As Single = 147.75
    Const Height As Single = 132.3
    
    ' Groups all actions into a single item in undo history
    Dim record As UndoRecord: Set record = Application.UndoRecord
    record.StartCustomRecord "Added Section"
    
    ' Show Dialog to Select the image
    '
    Dim oDialog As Dialog
    Set oDialog = Dialogs(wdDialogInsertPicture)
    With oDialog
        Call .Display
        filePath = .Name
    End With
    Set oDialog = Nothing
    If IsEmpty(filePath) Or Not IsFile(filePath) Then
        Exit Sub
    End If
    
    ' Set cursor position where we want the text-box
    '
    Dim addImageButton As Word.Shape
    Set addImageButton = doc.Shapes("VBA_AddImageMarker")
    addImageButton.Select
    Selection.MoveDown unit:=wdLine, Count:=2
    Selection.MoveRight unit:=wdCharacter, Count:=2
    
    ' Place the text-box shape at the current cursor position
    '   plus 1 down in vertical direction to prevent automatic moving to the previous paragraph during 'inlining'
    Set myShape = doc.Shapes.AddTextbox(msoTextOrientationHorizontal _
            , Selection.Information(wdHorizontalPositionRelativeToPage) _
            , Selection.Information(wdVerticalPositionRelativeToPage) + 1 _
            , Width, Height _
        )
    With myShape
        .Line.Visible = msoFalse ' hides border
        With .Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText2
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0.8000000119
            .Transparency = 0
            .Solid
        End With
        With .TextFrame
            .MarginLeft = 0
            .MarginRight = 0
            .MarginTop = 0
            .MarginBottom = 0
        End With
        With .TextFrame.TextRange
            .Shading.BackgroundPatternColor = wdColorWhite
            With .Font
                .Name = "Calibri"
                .NameBi = "+Body CS"
                .Size = 11
            End With
            .Text = Chr(13) & "NEW-TITLE" & Chr(13) _
                & "YET ANOTHER DESCRIPTION!!"
            Set imageShape = .InlineShapes.AddPicture(FileName:=filePath _
                    , LinkToFile:=msoFalse, SaveWithDocument:=True)
            With imageShape
                .LockAspectRatio = msoTrue
                .Width = Width
            End With
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LeftIndent = 0
                .RightIndent = 0
            End With
            With .Sentences(3)
                .Font.Size = 8
            End With
        End With
        '.Height = imageShape.Height + 30
        '.Width = Width
        .TextFrame.AutoSize = True
    
        With .ConvertToInlineShape
        End With
    End With
    
    addImageButton.Select
    Selection.MoveDown unit:=wdLine, Count:=2
    Selection.MoveRight unit:=wdCharacter, Count:=2
    Selection.MoveRight unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    
    record.EndCustomRecord
    End Sub