B
BC
I have a spreadsheet cell that I would like to copy not only it's text but
it's Font properties to a textbox object. Since a single cell could have
several different font attributes per each character, how do you accomplish
this without setting each character's font one by one.
Hopefully there is a better way!!!!
---------------------------------------------------------------------
Example code looks like (if needed):
Place some text into A1 on a spreadsheet and change some font attributes
(i.e. bold, size, boldness, color...) on some of the letters in the text.
Add a textbox somewhere on the page (don't change the name, it should
default to "Text Box 1").
Below is the code:
Option Explicit
Sub TryIt()
Dim i As Integer, acell As Range, tb As TextBox, f As Font
Set acell = ActiveSheet.Range("A1")
Set tb = ActiveSheet.TextBoxes("Text Box 1")
'--- copy the text
tb.Text = acell.Text
'--- copy the font attributes one-by-one.... ugggg!!!!
For i = 1 To acell.Characters.Count
Set f = acell.Characters(i, 1).Font
With tb.Characters(i, 1).Font
.Bold = f.Bold
.Color = f.Color
.ColorIndex = f.ColorIndex
.FontStyle = f.FontStyle
.Italic = f.Italic
.Name = f.Name
.OutlineFont = f.OutlineFont
.Shadow = f.Shadow
.Size = f.Size
.Strikethrough = f.Strikethrough
.Subscript = f.Subscript
.Superscript = f.Superscript
.Underline = f.Underline
End With
Next
End Sub
it's Font properties to a textbox object. Since a single cell could have
several different font attributes per each character, how do you accomplish
this without setting each character's font one by one.
Hopefully there is a better way!!!!
---------------------------------------------------------------------
Example code looks like (if needed):
Place some text into A1 on a spreadsheet and change some font attributes
(i.e. bold, size, boldness, color...) on some of the letters in the text.
Add a textbox somewhere on the page (don't change the name, it should
default to "Text Box 1").
Below is the code:
Option Explicit
Sub TryIt()
Dim i As Integer, acell As Range, tb As TextBox, f As Font
Set acell = ActiveSheet.Range("A1")
Set tb = ActiveSheet.TextBoxes("Text Box 1")
'--- copy the text
tb.Text = acell.Text
'--- copy the font attributes one-by-one.... ugggg!!!!
For i = 1 To acell.Characters.Count
Set f = acell.Characters(i, 1).Font
With tb.Characters(i, 1).Font
.Bold = f.Bold
.Color = f.Color
.ColorIndex = f.ColorIndex
.FontStyle = f.FontStyle
.Italic = f.Italic
.Name = f.Name
.OutlineFont = f.OutlineFont
.Shadow = f.Shadow
.Size = f.Size
.Strikethrough = f.Strikethrough
.Subscript = f.Subscript
.Superscript = f.Superscript
.Underline = f.Underline
End With
Next
End Sub