应用字体颜色&从单元格到形状的背景颜色

时间:2018-03-02 13:18:14

标签: excel-vba vba excel

我使用以下代码根据另一个工作表中单元格的内容在一个工作表上构建一个形状。不幸的是,形状不保持原始单元格的字体颜色和背景颜色。我可以编写代码来说明颜色和背景,但是考虑到我正在创建的宏,这将是很多工作。有没有人对如何编写代码来捕获原始颜色和背景有任何想法。非常感谢你的帮助。谢谢!

    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

1 个答案:

答案 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

enter image description here