我使用以下代码根据另一个工作表中单元格的内容在一个工作表上构建一个形状。不幸的是,形状不保持原始单元格的字体颜色和背景颜色。我可以编写代码来说明颜色和背景,但是考虑到我正在创建的宏,这将是很多工作。有没有人对如何编写代码来捕获原始颜色和背景有任何想法。非常感谢你的帮助。谢谢!
If ws1.Range("N3") <> 0 Then
Set b1 = ws2.Shapes.AddShape(msoShapeRectangle, 525, 235, 70, 70)
With b1
.TextFrame.Characters.Text = ws1.Range("N3")
.TextFrame.HorizontalAlignment = xlHAlignCenterAcrossSelection
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.Characters.Font.FontStyle = "Segoe UI Symbol"
.TextFrame.Characters.Font.Size = 40
.TextFrame.Characters.Font.Bold = True
.BackgroundStyle = msoBackgroundStyleNotAPreset
.ShapeStyle = msoLineStylePreset1
答案 0 :(得分:1)
这似乎有效:
Sub luxation()
Dim ws2 As Worksheet, b1 As Shape, r As Range
Set ws2 = ActiveSheet
Set r = ws2.Range("N3")
If r.Value <> 0 Then
Set b1 = ws2.Shapes.AddShape(msoShapeRectangle, 525, 235, 70, 70)
With b1
.TextFrame.Characters.Text = r.Value
.TextFrame.HorizontalAlignment = xlHAlignCenterAcrossSelection
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.Characters.Font.FontStyle = "Segoe UI Symbol"
.TextFrame.Characters.Font.Size = 40
.TextFrame.Characters.Font.Bold = True
.TextFrame.Characters.Font.Color = r.Font.Color
.ShapeStyle = msoLineStylePreset1
End With
b1.Select
Selection.Interior.Color = r.Interior.Color
End If
End Sub