2009年7月2日 星期四

[Lotus Script]_Word轉轉轉!

開啟Word檔、並插入自訂浮水印。
                                                                

Sub Initialize
'(WORD開開開)|agWordOpen
Dim session As New NotesSession
Dim db As NotesDatabase
Dim wdoc As NotesDocument
Dim pdoc As NotesDocument
Dim PrintHeadFlag As Integer
Dim DefWMStr As String,DefDocPath As String
Set db=session.CurrentDatabase
Set wdoc=session.DocumentContext

DefWMStr = "日期:" & Cstr(Today) & " // 作者:Signally" '設定水印文字
DefDocPath="D:\t1.dot" '設定路徑

Set oWord = CreateObject("Word.Application")
oWord.Application.Visible = True
oWord.documents.Add DefDocPath, False

'=======Insert Watermark======
oWord.ActiveDocument.Sections(1).Range.Select
oWord.ActiveWindow.ActivePane.View.SeekView = 9 'wdSeekCurrentPageHeader
oWord.Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject1,DefWMStr, "標楷體", 1, False, False, 0, 0).select
oWord.Selection.ShapeRange.Name = "PowerPlusWaterMarkObject1"
oWord.Selection.ShapeRange.TextEffect.NormalizedHeight = False
oWord.Selection.ShapeRange.Line.Visible = False
oWord.Selection.ShapeRange.Fill.Visible = True
oWord.Selection.ShapeRange.Fill.Solid
oWord.Selection.ShapeRange.Fill.ForeColor.RGB = 30 '色彩?
oWord.Selection.ShapeRange.Fill.Transparency = 0.6 '透明度
oWord.Selection.ShapeRange.Rotation = 315 '角度(依照頂端指向)
oWord.Selection.ShapeRange.LockAspectRatio = True
oWord.Selection.ShapeRange.Height =240 'CentimetersToPoints(4.13) '高
oWord.Selection.ShapeRange.Width = 270 'CentimetersToPoints(16.52) '寬
oWord.Selection.ShapeRange.WrapFormat.AllowOverlap = True
oWord.Selection.ShapeRange.WrapFormat.Side = wdWrapNone
oWord.Selection.ShapeRange.WrapFormat.Type = 3
oWord.Selection.ShapeRange.RelativeHorizontalPosition = 0 'wdRelativeVerticalPositionMargin '基準點
oWord.Selection.ShapeRange.RelativeVerticalPosition = 0 'wdRelativeVerticalPositionMargin '基準點
oWord.Selection.ShapeRange.Left = wdShapeCenter
oWord.Selection.ShapeRange.Top = wdShapeCenter
oWord.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'==========================
oWord.documents(1).SaveAs "d:\TryWM20090702.doc"
End Sub


--
---- 書本上查的到的東西 ---- 不用去背他 ----

沒有留言:

張貼留言