本文于2023年5月24日首发于本人同名公众号，更多文章案例请搜索关注！
☆本期内容概要☆
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 WithEnd SubPrivate Sub Workbook_Open() Call AddWatermarkEnd Sub
代码解析：
1、首先，我们定义一个添加水印的过程，AddWaterMark
2、接着，我们定义几个变量
3、给水印文字变量watermarkText赋值：固定文字+回车+当前日期。
4、然后，我们删除已有的水印。
5、添加新的水印，选中，定义它的旋转角度-25，无填充，无边框。
6、设置文字的格式。
7、这里通过i=1 to 4循环添加，它的Top值是不断增加的，间距相等。
8、在ThisWorkBook的Open事件中，调用AddWatermark过程，每次打开文件时，删除旧水印，添加新水印。
好，今天就分享到这，欢迎点赞、留言、分享，谢谢大家，我们下期再会。
☆猜你喜欢☆
本文使用 文章同步助手 同步，本文于2023年5月24日首发于本人同名公众号，更多文章案例请搜索关注！