VBA - 如何访问 "TextFrame2" 属性？
VBA - How to access "TextFrame2" property?
考虑我们创建一个包含图像 Inline-Shape 的文本框 Shape 并使用 VBA 脚本将其存储到 myShape 变量中，如下所示：
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
每当我们尝试访问 myShape.TextFrame2 属性，甚至使用如下所示的 Selection 时，为什么我们会收到“The specified value is out of range.”错误：
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.
这有帮助吗：
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
如果我录制一个 Excel 宏来增加饼图的 Legend 字体大小，则会生成以下 VBA 代码：
With ActiveSheet.Shapes("Chart 1").TextFrame2.TextRange.Font
.BaselineOffset = 0
.Size = 18
End With
当我尝试 运行 这个宏时，我也遇到了 "specified value is out of range" 错误。我认为这确实表明存在真正的底层 Excel/VBA 软件故障，并且 "Answer" 是该故障的解决方法。
考虑我们创建一个包含图像 Inline-Shape 的文本框 Shape 并使用 VBA 脚本将其存储到 myShape 变量中，如下所示：
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
每当我们尝试访问 myShape.TextFrame2 属性，甚至使用如下所示的 Selection 时，为什么我们会收到“The specified value is out of range.”错误：
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.
这有帮助吗：
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
如果我录制一个 Excel 宏来增加饼图的 Legend 字体大小，则会生成以下 VBA 代码：
With ActiveSheet.Shapes("Chart 1").TextFrame2.TextRange.Font
.BaselineOffset = 0
.Size = 18
End With
当我尝试 运行 这个宏时，我也遇到了 "specified value is out of range" 错误。我认为这确实表明存在真正的底层 Excel/VBA 软件故障，并且 "Answer" 是该故障的解决方法。