Dynamicly change header in word

[kalle82]

Hi!

This is a very noobish program... So i know i can do things better but first i need to make them work..

Im using this code to change the header of my document.

Problem is that it works the first time, next tim ill run it i stops because it has deleted the the second header in the first section.

Is there a better way of looping through the
headers and adding code.. as you can see the headers are layouted, and the text needs to come in the right cell.

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    ActiveWindow.ActivePane.View.NextHeaderFooter
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Beslut"
    ActiveWindow.ActivePane.View.NextHeaderFooter
    Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
        LinkToPrevious
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Bilaga 1"
    ActiveWindow.ActivePane.View.NextHeaderFooter
    Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
        LinkToPrevious
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Bilaga 2"
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.GoTo What:=wdGoToBookmark, Name:="bokmark5"

The build its used with

ElseIf OptionButton3.Value = True Then

' Ställer markören rätt

Selection.GoTo wdGoToBookmark, Name:="bokmark5"
' Lägga till bokmärken

Selection.MoveDown Unit:=wdLine, Count:=1
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text1"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text2"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text3"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text4"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text5"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text6"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
    Selection.TypeParagraph
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text7"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With
     Selection.InsertBreak Type:=wdPageBreak
    ' sparad pagebreak
    'Selection.InsertBreak Type:=wdPageBreak
    
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="text8"
        .DefaultSorting = wdSortByLocation
        .ShowHidden = False
    End With