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.
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
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