I've got an AutoText entry labelled DRAFT which was created in
WordArt.

I need to place this in the document throught all the header stories.
The procedure I've got does this adequately but it seems to place it
in the wrong place - for me, at least. My procedure to delete each
DRAFT works perfectly.

Then I got the idea if it was selected it could be moved to where I
want to set it. The code between the **** illustrated what I've tried
to do. However, without any results

This is the code:
    Application.ScreenUpdating = False
 'Fix the skipped blank Header/Footer problem
 xJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
 'Iterate through all story types in the current document
 For Each xStory In ActiveDocument.StoryRanges
   'Iterate through all linked stories
   Do
     On Error Resume Next
     Select Case xStory.StoryType
     Case wdEvenPagesHeaderStory, wdFirstPageHeaderStory,
wdPrimaryHeaderStory
'first deletes the DRAFT in the headers to prevent layering
'if user presses DRAFT a second time
       If xStory.ShapeRange.Count > 0 Then
         For Each xShp In rngStory.ShapeRange
'calls the Delete DRAFT procedure
   DeleteDraft
         Next
       End If
'now puts DRAFT in each header
 Set xRange = xStory
 xRange.Collapse Direction:=wdCollapseStart
 ActiveDocument.AttachedTemplate.AutoTextEntries("Draft").Insert _
     Where:=xRange, RichText:=True
************************************    
          For Each xShp In rngStory.ShapeRange
           If xShp.Type = msoTextEffect Then
               xShp.RelativeHorizontalPosition =
wdRelativeHorizontalPositionPage
               xShp.RelativeVerticalPosition =
wdRelativeVerticalPositionPage
               xShp.Left = CentimetersToPoints(6)
               xShp.Top = CentimetersToPoints(13)
           End If
***********************************
         Next
     Case Else
       'Do Nothing
     End Select
     On Error GoTo 0
     'Get next linked story (if any)
     Set xStory = xStory.NextStoryRange
   Loop Until xStory Is Nothing
 Next
'go back to the top of the document
   ActiveDocument.Bookmarks("\StartofDoc").Select
       
   Application.ScreenUpdating = True

Can anyone help with this challenge I've got, please?

Roderick