Inserir Marca d' Água de Texto apenas em uma página.
Neste tutorial criaremos uma macro cujo objetivo é Inserir uma Marca d’ Água de Texto em apenas uma página, previamente selecionada pelo usuário.
Abra o documento no qual deseja inserir uma Marca d’ Água de Texto. Em seguida na Guia Desenvolvedor, no Grupo Código, clique em Visual Basic.
No ambiente de desenvolvimento clique no menu Inserir e depois clique em Módulo,para inserir um novo módulo.
Na Janela de Código adicione o seguinte código:
Sub Marcadaguatexto()
Dim mdat As Shape
Set mdat = ActiveDocument.Shapes.AddTextEffect(powerpluswatermarkobject1, _
"SEUTEXTO AQUI", "Arial Black", 40, False, False, 0, 0)
mdat.Name = "Marca d’ Água de Texto"
mdat.Rotation = 315
mdat.LockAspectRatio = True
mdat.Height = InchesToPoints(0.77)
mdat.Width = InchesToPoints(2.04)
mdat.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
mdat.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
mdat.Left = wdShapeCenter
mdat.Top = wdShapeCenter
mdat.TextEffect.NormalizedHeight = False
mdat.Line.Visible = False
mdat.Fill.Visible = True
mdat.Fill.ForeColor.RGB = RGB(196, 120, 120)
mdat.Fill.Transparency = 0.5
mdat.WrapFormat.AllowOverlap = True
mdat.WrapFormat.Side = wdWrapNone
mdat.WrapFormat.Type = 3
End Sub
Ficará como na imagem abaixo:
Feche o Editor do VBA para voltar ao Word.
Posicione o cursor (ponto de inserção) na página onde deseja inserir a Marca d’ Água de Texto, neste exemplo iremos inserir na segunda página.
Para executar a macro acione a Guia Desenvolvedor e no Grupo Código clique em Macros.
Selecione a macro Marcadaguatexto e clique em executar
Veja o resultado e observe que a Marca d’ Água de Texto foi inserida apenas na segunda página.
Considerações Finais:
Você pode alterar o tipo e tamanho da fonte, bem como configurar a rotação, posição, transparência, etc, do texto mudando os valores das propriedades conforme suas necessidades:
A partir deste pequeno exemplo você pode também criar um formulário para que o usuário digite o texto desejado.
Veja um exemplo:
Crie um formulário como na imagem abaixo.
No evento Click do botão Inserir adicione o seguinte código:
Private Sub CommandButton1_Click()
Dim marcdagua As String
Dim mdat As Shape
marcdagua = TextBox1.Text
Set mdat = ActiveDocument.Shapes.AddTextEffect(powerpluswatermarkobject1, _
"marcdagua", "Arial Black",
40, False, False, 0, 0)
mdat.Name = "Marca d' Água de Texto"
mdat.Rotation = 300
mdat.LockAspectRatio = True
mdat.Height = InchesToPoints(0.77)
mdat.Width = InchesToPoints(2.04)
mdat.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
mdat.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
mdat.Left = wdShapeCenter
mdat.Top = wdShapeCenter
mdat.TextEffect.NormalizedHeight = False
mdat.Line.Visible = False
mdat.Fill.Visible = True
mdat.Fill.ForeColor.RGB = RGB(196, 120, 120)
mdat.Fill.Transparency = 0.5
mdat.WrapFormat.AllowOverlap = True
mdat.WrapFormat.Side = wdWrapNone
mdat.WrapFormat.Type = 3
End Sub
Ficará como na imagem abaixo:
Execute o formulário e digite um texto na Caixa de Texto (TextBox1).
Clique no botão Inserir, feche o Formulário e veja o resultado.
Se quiser que Marca d’ Água de Texto apareça em todas as páginas utilize a macro a baixo:
Sub Marcadaguatexto2()
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( marcadagua, "SEU TEXTO AQUI", "Arial Back", 1, _
False, False, 0, 0).Select
Selection.ShapeRange.Name = "marcadagua"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
Selection.ShapeRange.Line.Visible = False
Selection.ShapeRange.Fill.Visible = True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192,80, 77)
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(3.02)
Selection.ShapeRange.Width = CentimetersToPoints(18.12)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Gostou? Se quiser mais eu tenho um e-Book sobre VBA que você pode se interessar.
Confira aqui
