我有以下代码
Dim TB As TextBox
Dim mycell As Range
ThisWorkbook.Worksheets("Print").Activate
Cells(r, 1).Select
Dim mytext As String
Set mycell = ActiveCell
With mycell
Set TB = .Parent.TextBoxes.Add(top:=.top, Left:=.Left, Width:=Range(Cells(r, 1), Cells(r, 9)).Width, Height:=42)
TB.Name = "TB"
TB.Font.Size = 10
TB.Font.Name = "Tahoma"
End With
TB.ShapeRange.Line.Visible = msoFalse
Dim c As Range
Dim i As Integer
i = 0
For Each c In table.Rows
If Not IsEmpty(c.Value) Then
i = i + 1
If i < [Circumstances_Count] Then
TB.text = mytext & Chr(149) & " " & c.Value & vbNewLine
Else
TB.text = mytext & Chr(149) & " " & c.Value
End If
mytext = TB.text
End If
Next c
它可以按预期方式创建带有项目符号点的文本框,并且仅包含带有“表”范围数据的字段
问题在于它没有粗体字或斜体等文本格式。
我如何也模仿格式?
谢谢。
答案 0 :(得分:0)
您可以参考以下代码或使用Link获取更多格式:
With mycell
Set TB = .Parent.TextBoxes.Add(Top:=.Top, Left:=.Left, Width:=Range(Cells(r, 1), Cells(r, 9)).Width, Height:=42)
TB.Name = "TB"
TB.Font.Size = 10
TB.Font.Name = "Tahoma"
TB.Characters.Text = "test"
TB.Characters.Font.Bold = True
TB.Characters.Font.Italic = True
End With
我也注意到您会在网上遇到错误
Cells (r, 1) .Select
。
您尚未为r
分配值,您可能已经意识到这一点,并且知道如何解决它。
答案 1 :(得分:0)
执行此操作的一种方法是将文本框中的位置保存在其中来自粗体/斜体单元格的内容中。然后,根据这些单元格的长度,可以在写完文本框后将格式应用于文本框内的字符。
我建议使用2个数组来存储有关位置和需要格式化的文本长度的信息。
例如,您可以尝试以下方法:
Dim BoldList() As Variant
ReDim BoldList(1 To Table.Rows.Count, 1 To 2)
Dim ItalicList() As Variant
ReDim ItalicList(1 To Table.Rows.Count, 1 To 2)
Dim c As Range
Dim i As Integer
i = 0
For Each c In Table.Rows
If Not IsEmpty(c.Value) Then
i = i + 1
If c.Font.Bold Then
BoldList(i, 1) = Len(mytext) + 3
BoldList(i, 2) = Len(c.Value)
End If
If c.Font.Italic Then
ItalicList(i, 1) = Len(mytext) + 3
ItalicList(i, 2) = Len(c.Value)
End If
If i < [Circumstances_Count] Then
TB.Text = mytext & chr(149) & " " & c.Value & vbNewLine
BoldList(i, 2) = BoldList(i, 2) + 1
ItalicList(i, 2) = ItalicList(i, 2) + 1
Else
TB.Text = mytext & chr(149) & " " & c.Value
End If
mytext = TB.Text
End If
Next c
'Apply the formatting
For i = 1 To UBound(BoldList)
If Not IsEmpty(BoldList(i, 1)) Then
TB.Characters(BoldList(i, 1), BoldList(i, 2)).Font.Bold = True
End If
Next i
For i = 1 To UBound(ItalicList)
If Not IsEmpty(ItalicList(i, 1)) Then
TB.Characters(ItalicList(i, 1), ItalicList(i, 2)).Font.Italic = True
End If
Next i