Помогает ли это:
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
Пример:
Ниже описано, что сработало для OP, который, как предлагается в комментариях, использует Shape.TextFrame.TextRange.Sentences(index As Long) As Range
для изменения параметров шрифта для конкретного абзаца:
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