Sco*_*nes 7 excel vba excel-vba
我正在寻找一种方法将文本插入到单元格的背景中,这样我仍然可以在该文本的顶部输入数字 - 类似于除了单个单元格之外的水印.有没有办法做到这一点,最好不要使用宏(但也可以使用这些解决方案)?
与Andrews post类似,这是VBA版本,它正确地格式化形状,并允许直接选择单元格.

代码模块:
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
Run Code Online (Sandbox Code Playgroud)
更新:
下面的示例将单元格地址的水印分配给奇数行,并将偶数行作为常量watermark.这是基于我的评论的一个例子,任何单元格都可以根据你想要的任何条件分配任何水印文本.

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
Run Code Online (Sandbox Code Playgroud)
您可以使用自定义数字格式指定当单元格值为0时要显示的浅灰色文本 - Color15产生漂亮的水印颜色:
[Black]000000;;[Color15]"(order number)";@
Run Code Online (Sandbox Code Playgroud)

当值实际被填满时,没有凌乱的形状,没有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
Run Code Online (Sandbox Code Playgroud)
然后你可以这样做:
myCell.NumberFormat = BuildWatermarkFormat("Please enter a value")
myCell.Value = 0
Run Code Online (Sandbox Code Playgroud)
您仍然可以根据需要提供正/负值的自定义格式; 唯一的是0保留"无价值"并触发水印.
myCell.NumberFormat = BuildWatermarkFormat("Please enter a value", "[Blue]#,##0.00_)", "[Red](#,##0.00)")
myCell.Value = -25
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
72906 次 |
| 最近记录: |