VBA - Как получить доступ к свойству "TextFrame2"? - PullRequest
1 голос
/ 09 мая 2019

Предположим, мы создаем текстовое поле Shape, содержащее изображение Inline-Shape и сохраняем его в переменной myShape с помощью скрипта VBA, как показано ниже:

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

Почему мы получаем ошибку "The specified value is out of range.", когда пытаемся получить доступ к свойству myShape.TextFrame2 или даже используем Selection, как показано ниже:

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

Примечание. Я пытаюсь задать форматирование текста, например, сделать текстовую часть "NEW-TITLE" полужирным , оставив оставшийся текст без изменений.

1 Ответ

1 голос
/ 09 мая 2019

Помогает ли это:

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