本文于2023年5月24日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
☆本期内容概要☆
- VBA插入形状文本框水印，日期随系统日期变化。
- 批量删除水印
大家好，我是冷水泡茶，今天在EXCELHOME论坛上看到一个网友求助的贴子：
我一看，这玩意我搞过啊，在我的《财务管理系统》中，我就添加了水印的。
需求分析：
1、日期变化，我们理解为，跟随系统日期变化，即每天打开文件时，这个水印上的日期与当前系统日期一致。
2、文字固定，就是水印中除日期以外的文字不变。
3、共4个，要添加4个同样的水印。
需求分析完了，直接开干吧！
把我以前的代码复制过来改一改，初步结果是这样的（代码见第二条文章）：
然而，问题来了，人家要的水印是灰色的，怎么办呢？我又翻出了我以前搞的一个艺术字效果大全（“我是艺术字”），点删除，清除所有艺术字，点添加，添加1~48号艺术字（代码我也放到第二条）。
共有48种艺术字效果，但没有一种是符合要求的。于是就改吧，改了半天，最终发现用艺术字可能是不行的，应该用形状加文字。
于是，请教ChatGPT吧，它给的代码基本能行，但是没有倾斜（旋转），又录制了几个宏，总之，一顿*操作以后，终于完成了，代码如下：
Sub AddWatermark()
Dim shp As Shape
Dim watermarkText As String
Dim pageHeight As Double
Dim shpWidth As Double
Dim centerTop As Double
Dim Top As Double
watermarkText = "联邦调查局联邦调查局联邦调查局" & Chr(10) & Format(Date, "YYYY-MM-DD")
Sheets("联邦").Activate
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
shp.Delete
End If
Next
With ActiveSheet
pageHeight = 11.69 * 72
Top = 150
centerTop = Top
shpWidth = 350
For i = 1 To 4
Set shp = .Shapes.AddTextbox(msoTextOrientationHorizontal, 90, centerTop, shpWidth, 100)
With shp
.Select
With Selection
.ShapeRange.IncrementRotation -25
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Line.Visible = msoFalse
End With
.TextFrame.Characters.Text = watermarkText
.TextFrame.Characters.Font.Size = 20
.TextFrame.Characters.Font.Color = RGB(150, 150, 150)
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.Orientation = 1
.TextFrame.AutoSize = False
.LockAspectRatio = msoTrue
.Top = centerTop - (.Height / 2)
End With
centerTop = centerTop shp.Height (pageHeight - Top - shp.Height * 4) / 3
Next
End With
End Sub
Private Sub Workbook_Open()
Call AddWatermark
End Sub
代码解析：
1、首先，我们定义一个添加水印的过程，AddWaterMark
2、接着，我们定义几个变量
3、给水印文字变量watermarkText赋值：固定文字 回车 当前日期。
4、然后，我们删除已有的水印。
5、添加新的水印，选中，定义它的旋转角度-25，无填充，无边框。
6、设置文字的格式。
7、这里通过i=1 to 4循环添加，它的Top值是不断增加的，间距相等。
8、在ThisWorkBook的Open事件中，调用AddWatermark过程，每次打开文件时，删除旧水印，添加新水印。
好，今天就分享到这，欢迎点赞、留言、分享，谢谢大家，我们下期再会。
☆猜你喜欢☆
【重磅】Excel VBA 应用分享/中医诊所收费系统/Excel ListBox版 | Excel VBA 动态添加控件/学生成绩筛选 |
Excel VBA 这样酷炫的日期控件，你不想要吗？ | Excel 公式函数/数据透视表/固定资产折旧计提表！ |
Excel VBA 自定义函数/数组字段定位/数组字段排序 | Excel 功能/公式函数/VBA/多种姿势处理重复值 |
Excel VBA 最简单的收发存登记系统 | Excel 公式函数/查找函数之LOOKUP |
Excel VBA 文件批量改名 | Excel 公式函数/数据验证/动态下拉列表 |
Excel VBA 输入逐步提示/TextBox ListBox | Excel 基础功能【数据验证】，你会怎么用？ |
本文于2023年5月24日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
