how to put a date on the first page of the document ?

[newcodeboy]

good afternoon, someone knows how to put a date on the first page of the document using Word VBA macros (the date has to go polygonal position, centered and background)

I also need to know how to remove that date using VBA macros



Thanks in advance for your valuable help:yes

[gmayor]

the date has to go polygonal position, centered and backgroundWhat does this mean?

[newcodeboy]

I mean this (image attached)

14696

I want to do it through VBA macros.
only on the first page and I need to know how to remove it by VBA macros



What does this mean?

[gmayor]

The following method re-purposes a built-in building block to add the data in the first page header:


Sub InsertDateWatermark()
Dim oRng As Range
Dim oHeader As HeaderFooter
Dim oTemplate As Template
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
Set oRng = oHeader.Range
On Error Resume Next
For Each oTemplate In Application.Templates
If oTemplate.name Like "Built-In Building Blocks*" Then
oTemplate.BuildingBlockEntries("CONFIDENTIAL 1").Insert Where:=oRng, _
RichText:=True
End If
Next oTemplate
With oRng.ShapeRange.Item(1)
.TextEffect.Text = Format(Date, "Short Date")
.TextEffect.FontSize = 24
.Height = 29.25
.Width = 102#
End With
lbl_Exit:
Exit Sub
End Sub


To remove it

Sub RemoveDateWatermark()
Dim oRng As Range
Dim oHeader As HeaderFooter
On Error Resume Next
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
Set oRng = oHeader.Range
oRng.ShapeRange.Item(1).Delete
lbl_Exit:
Exit Sub
End Sub

[newcodeboy]

brother thanks for the help, I place the code "Format (Now," dd / mm / yyyy ") but not displayed in the document. Annex picture

I know why this happens


14699


The following method re-purposes a built-in building block to add the data in the first page header:


Sub InsertDateWatermark()
Dim oRng As Range
Dim oHeader As HeaderFooter
Dim oTemplate As Template
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
Set oRng = oHeader.Range
On Error Resume Next
For Each oTemplate In Application.Templates
If oTemplate.name Like "Built-In Building Blocks*" Then
oTemplate.BuildingBlockEntries("CONFIDENTIAL 1").Insert Where:=oRng, _
RichText:=True
End If
Next oTemplate
With oRng.ShapeRange.Item(1)
.TextEffect.Text = Format(Date, "Short Date")
.TextEffect.FontSize = 24
.Height = 29.25
.Width = 102#
End With
lbl_Exit:
Exit Sub
End Sub


To remove it

Sub RemoveDateWatermark()
Dim oRng As Range
Dim oHeader As HeaderFooter
On Error Resume Next
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
Set oRng = oHeader.Range
oRng.ShapeRange.Item(1).Delete
lbl_Exit:
Exit Sub
End Sub

[gmaxey]

I would do that a bit differently using either a Date (as shown below) or CreateDate field:


Sub InsertDateWatermark()
Dim oHeader As HeaderFooter
Dim oShp As Shape
Dim oFld As Field
Dim oShpRng As ShapeRange
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
For Each oShp In oHeader.Shapes
If oShp.Name = "Psuedo Date Watermark" Then
'Watermark already exists.
oShp.TextFrame.TextRange.Fields(1).Update
GoTo lbl_Exit
Exit For
End If
Next oShp
'Insert an appropriately sized basic shape (rectangle)
Set oShp = oHeader.Shapes.AddShape(msoShapeRectangle, 1, 1, 350, 100)
With oShp
'Name and format the shape appearance.
.Name = "Psuedo Date Watermark"
.IncrementRotation -45
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
End With
'Add a DATE field to the shape text frame.
Set oFld = oShp.TextFrame.TextRange.Fields.Add(oShp.TextFrame.TextRange, wdFieldEmpty, "DATE \@ ""MMMM d, yyyy""")
'Format the text range.
With oShp.TextFrame.TextRange
.Font.Size = 24
.Font.ColorIndex = wdGray25
End With
'Position the shape independent of any other shape in the header.
Set oShpRng = oHeader.Shapes.Range("Psuedo Date Watermark")
With oShpRng
.Align msoAlignCenters, True 'relative to document edges.
.Align msoAlignMiddles, True
End With
lbl_Exit:
Exit Sub
End Sub
Sub RemoveDateWatermark()
Dim oRng As Range
Dim oHeader As HeaderFooter
Dim oShp As Shape
Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
For Each oShp In oHeader.Shapes
If oShp.Name = "Psuedo Date Watermark" Then
oShp.Delete
Exit For
End If
Next oShp
lbl_Exit:
Exit Sub
End Sub