Word VBA, Onjuist tekenobject

[remcop1989]

Mijn doel is om middels een macro eenvoudig een veelvoorkomend watermerk aan onze documenten toe te voegen.

Ik gebruik de volgende code.

In Normal --> Microsoft Word -objecten --> ThisDocument

Public Function InputBox( _
   ByVal Prompt As String, _
   Optional ByVal Title As String = "", _
   Optional ByVal DefaultResponse As String = "", _
   Optional ByVal Xpos As Integer = -1, _
   Optional ByVal YPos As Integer = -1 _
) As String
End Function

In een module

Sub Watermerk()

Dim afmelddatum As Date

afmelddatum = InputBox("Wat is de afmelddatum?", _
              "Afmelddatum", Date)

activedocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject, "Afgemeld" & afmelddatum, "Arial", 1, False, False, 0, 0).Select
With Selection.ShapeRange
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 7, 7)
.Fill.Transparency = 0
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(12.41)
.Width = CentimetersToPoints(22.03)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Wat gaat er nu mis?
- ik open een nieuw document
- ik start de macro
- een inputbox verschijnt correct
- ik vul de gewenste tekst in en klik op "ok"
- vervolgens krijg ik de foutmelding (zie bijlage) op de volgende regel:

.TextEffect.NormalizedHeight = False

- hij lijkt tevens de tekst heeel klein in de koptekst van het document te plaatsen, maar dat kan ik niet goed lezen.


Als ik nu naar foutopsporing ga stop ik de foutopsporing. Ik voer de macro nogmaals uit en hij werkt perfect.

Wat gaat hier fout.....?

 

[snb]

Ik ondervond geen problemen met:

sub M_snb()
    With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.AddTextEffect(PowerPlusWaterMarkObject11455953, "Afgemeld: " & Format(Date, "dd-mm-yyyy"), "Univers", 1, False, False, 0, 0)
        .Rotation = 315
        .Height = CentimetersToPoints(4.1)
        .Width = CentimetersToPoints(18.46)
        .WrapFormat.AllowOverlap = True
        .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .Left = wdShapeCenter
        .Top = wdShapeCenter
    End With
End Sub

 

[remcop1989]

opgelost