将文本插入单元格的背景中

时间:2013-08-12 21:41:24

标签: excel excel-vba vba

我正在寻找一种方法将文本插入到单元格的背景中,这样我仍然可以在该文本的顶部输入数字 - 类似于除了单个单元格之外的水印。有没有办法做到这一点,最好不要使用宏(但也可以使用这些解决方案)?

4 个答案:

答案 0 :(得分:7)

  • 选择要制作背景的单元格。
  • 单击“插入”并在该位置插入矩形形状。
  • 右键单击形状 - 选择“格式化形状”
  • 转到“填充”并选择“图片或纹理填充”
  • 转到“从文件插入”选项
  • 选择要制作水印的图片
  • 图片将出现在矩形的地方
  • 现在点击图片“右键单击”并选择格式图片
  • 转到“填充”并根据需要增加透明度,使其看起来像“水印”或浅色背景
  • 这也会打印出来。

taken from here

答案 1 :(得分:7)

类似于Andrews post,这是VBA版本,它正确地格式化形状,并允许直接选择单元格。

enter image description here

代码模块:

Sub watermarkShape()
Const watermark As String = "watermark"
Dim cll As Range
Dim rng As Range
Dim ws As Worksheet
Dim shp As Shape

    Set ws = Sheet1
    Set rng = ws.Range("A1:F10") 'Set range to fill with watermark

    Application.ScreenUpdating = False

    For Each shp In ws.Shapes
        shp.Delete
    Next shp

    For Each cll In rng

        Set shp = ws.Shapes.AddShape(msoShapeRectangle, 5, 5, 5, 5)

        With shp
            .Left = cll.Left
            .Top = cll.Top
            .Height = cll.Height
            .Width = cll.Width

            .Name = cll.address
            .TextFrame2.TextRange.Characters.Text = watermark
            .TextFrame2.TextRange.Font.Name = "Tahoma"
            .TextFrame2.TextRange.Font.Size = 8
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .TextFrame2.WordWrap = msoFalse
            .TextFrame.Characters.Font.ColorIndex = 15
            .TextFrame2.TextRange.Font.Fill.Transparency = 0.35

            .Line.Visible = msoFalse
'            Debug.Print "'SelectCell (""" & ws.Name & """,""" & cll.address & """)'"
            .OnAction = "'SelectCell """ & ws.Name & """,""" & cll.address & """'"

            With .Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .Transparency = 1
                .Solid
            End With

        End With


    Next cll

    Application.ScreenUpdating = True
End Sub

Sub SelectCell(ws, address)
    Worksheets(ws).Range(address).Select
End Sub

更新:

下面的示例将单元格地址的水印分配给奇数行,并将偶数行作为常量watermark。根据我的评论,这是一个例子,可以根据你想要的任何条件为任何单元格分配任何水印文本。

enter image description here

Option Explicit

Sub watermarkShape()
Const watermark As String = "watermark"
Dim cll As Range
Dim rng As Range
Dim ws As Worksheet
Dim shp As Shape

    Set ws = Sheet1
    Set rng = ws.Range("A1:F10") 'Set range to fill with watermark

    Application.ScreenUpdating = False

    For Each shp In ws.Shapes
        shp.Delete
    Next shp

    For Each cll In rng

        Set shp = ws.Shapes.AddShape(msoShapeRectangle, 5, 5, 5, 5)

        With shp
            .Left = cll.Left
            .Top = cll.Top
            .Height = cll.Height
            .Width = cll.Width

            .Name = cll.address
            If cll.Row Mod 2 = 1 Then
                .TextFrame2.TextRange.Characters.Text = cll.address
            Else
                .TextFrame2.TextRange.Characters.Text = watermark
            End If
            .TextFrame2.TextRange.Font.Name = "Tahoma"
            .TextFrame2.TextRange.Font.Size = 8
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .TextFrame2.WordWrap = msoFalse
            .TextFrame.Characters.Font.ColorIndex = 15
            .TextFrame2.TextRange.Font.Fill.Transparency = 0.35

            .Line.Visible = msoFalse
'            Debug.Print "'SelectCell (""" & ws.Name & """,""" & cll.address & """)'"
            .OnAction = "'SelectCell """ & ws.Name & """,""" & cll.address & """'"

            With .Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .Transparency = 1
                .Solid
            End With

        End With


    Next cll

    Application.ScreenUpdating = True
End Sub

Sub SelectCell(ws, address)
    Worksheets(ws).Range(address).Select
End Sub

答案 2 :(得分:5)

您可以使用自定义数字格式指定当单元格值为0时显示的浅灰色文本 - Color15可以生成漂亮的水印颜色:

[Black]000000;;[Color15]"(order number)";@

watermarked cells

没有凌乱的形状,没有VBA,并且当实际填充值时水印消失。

如果您绝对需要在VBA中执行此操作,那么您可以轻松编写一个基于某些参数构建格式字符串的函数:

Public Function BuildWatermarkFormat(ByVal watermarkText As String, Optional ByVal positiveFormat As String = "General", Optional ByVal negativeFormat As String = "General", Optional ByVal textFormat As String = "General") As String
    BuildWatermarkFormat = positiveFormat & ";" & negativeFormat & ";[Color15]" & Chr(34) & watermarkText & Chr(34) & ";" & textFormat
End Function

然后你可以这样做:

myCell.NumberFormat = BuildWatermarkFormat("Please enter a value")
myCell.Value = 0

您仍然可以根据需要提供正/负值的自定义格式;唯一的事情是0被保留为“无价值”并触发水印。

myCell.NumberFormat = BuildWatermarkFormat("Please enter a value", "[Blue]#,##0.00_)", "[Red](#,##0.00)")
myCell.Value = -25

答案 3 :(得分:-1)

在任何地方的单元格中输入文字。 复制它,它将保存在剪贴板上。 在任何地方插入矩形。 右键单击并选择"发送回"。 这将确保它将在后台。 右键单击"格式化形状"。 选项卡"填写"并点击"图片或纹理填充"。 来自"来自"选择"剪贴板"。 现在,您复制到剪贴板上的任何文本都将呈矩形。 调整形状大小以适合所需的单元格。 但是你喜欢调整,例如删除矩形线,添加阴影,更改字体,删除背景等。