- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- word满屏水印 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=175753)
-- 发布时间：2022/3/17 17:11:00
-- word满屏水印
请问下老师,下面这个可以修改成满屏水印吗?
try
Dim fileName = "d:\\test.doc"
Dim doc = app.Documents.Open(fileName)
app.ActiveWindow.Selection.Range.Select()
doc.Application.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
app.Selection.HeaderFooter.Shapes.AddTextEffect(1, "公司绝密", "宋体", 1, False, False, 0, 0).Select
app.Selection.ShapeRange.Name = "PowerPlusWaterMarkObject1"
app.Selection.ShapeRange.TextEffect.NormalizedHeight = False
app.Selection.ShapeRange.Line.Visible = False
app.Selection.ShapeRange.Fill.Visible = True
app.Selection.ShapeRange.Fill.Solid
app.Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
app.Selection.ShapeRange.Fill.Transparency = 0.5
app.Selection.ShapeRange.Rotation = 315
app.Selection.ShapeRange.LockAspectRatio = True
app.Selection.ShapeRange.Height = app.CentimetersToPoints(4.13)
app.Selection.ShapeRange.Width = app.CentimetersToPoints(16.52)
app.Selection.ShapeRange.WrapFormat.AllowOverlap = True
app.Selection.ShapeRange.WrapFormat.Side = MSWord.WdWrapSideType.wdWrapBoth
app.Selection.ShapeRange.WrapFormat.Type = 3
app.Selection.ShapeRange.RelativeHorizontalPosition = MSWord.WdRelativeVerticalPosition.wdRelativeVerticalPositionMargin
app.Selection.ShapeRange.RelativeVerticalPosition = MSWord.WdRelativeVerticalPosition.wdRelativeVerticalPositionMargin
app.Selection.ShapeRange.Left = -999995
app.Selection.ShapeRange.Top = -999995
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument
doc.save
app.Visible = True
\'app.quit
catch ex As exception
msgbox(ex.message)
app.quit
finally
\'app.Quit
End try
-- 发布时间：2022/3/17 17:12:00
--
现在是什么效果？满屏又是什么效果？
-- 发布时间：2022/3/17 17:23:00
--
此主题相关图片如下：微信截图_20220317172148.png
[此贴子已经被作者于2022/3/17 17:22:58编辑过]
-- 发布时间：2022/3/17 17:26:00
--
参考：http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=90243
-- 发布时间：2022/3/17 17:34:00
--
谢谢老师,如果要插入图片水印呢?就是页眉页脚插入两张不一样的图片
-- 发布时间：2022/3/17 17:38:00
--
水印只能有一个，把图片合并为一张
-- 发布时间：2022/3/17 17:46:00
--
好,那单张的图片水印要怎么加?
-- 发布时间：2022/3/17 20:45:00
--
按照骑缝章的用法，添加一个图片作为底图就行了
-- 发布时间：2022/3/17 21:25:00
--
老师,下面这个是默认给文档的第一节填充水印,如果文档有多节的时候,要每一节都填充水印怎么修改下代码?
Dim app As New MSWord.Application
try
Dim doc = app.Documents.Open("f:\\123.doc")
With doc
.Activate
app.WordBasic.RemoveWatermark \'删除旧的水印
For Each oSec As object In doc.Sections \'文档的节中循环
Dim myRange = oSec.Headers(MSWord.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
myRange.Delete \'删除页眉中的内容
Next
.Sections(1).Range.Select
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader \'插入水印前需更改视图样式为页眉视图
Dim i As Integer
For i = 1 To 3
\'设置插入水印,语法:表达式.AddTextEffect(预设文字效果, 文字内容, 字体名, 字体大小, 是否粗体, 是否斜体, 左侧位置, 顶部位置)
app.Selection.HeaderFooter.Shapes.AddTextEffect(10, "Foxtable 2016 ","宋体", 36, False, False, 0,i*200).Select
Next
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument \'恢复视图样式到原来样式
End With
doc.save
app.quit
catch ex As exception
app.quit
msgbox(ex.message)
End try
-- 发布时间：2022/3/17 21:42:00
--
放到遍历里面添加水印呀