Visual Basic - Word - Encabezado

Tengo este funcion de word:

Public Function WordDoc(ByVal biopsia As String)
Dim objWord As New Word.Application
Dim Rst As New ADODB.Recordset
Dim Cnx As New ADODB.Connection
Dim documento As String
Dim Sql As String
Dim strLimpio, strLetra As String
Dim NoExam, Direccion As String
Direccion = "C:\definiti1\" + Left(biopsia, 4) + "\" + biopsia + ".doc"
' Genero Encabezado *****************************************
With objWord
.Application.Documents.Open Direccion
.Selection.WholeStory
.Selection.Delete Unit:=wdCharacter, Count:=1
Call Shell("c:\QuickS\header\header.exe", vbHide)
Sleep 1000
.Selection.TypeParagraph
.Selection.MoveUp Unit:=wdLine, Count:=1
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
With .Selection.Font
.Name = "Bookman Old Style"
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.Strikethrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Animation = wdAnimationNone
End With
.Selection.Font.Italic = wdToggle
.Selection.MoveUp Unit:=wdLine, Count:=1
.Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
If .Selection.Font.Underline = wdUnderlineNone Then
.Selection.Font.Underline = wdUnderlineSingle
Else
.Selection.Font.Underline = wdUnderlineNone
End If
With .Selection.Font
.Name = "Bookman Old Style"
.Size = 20
.Bold = True
.Italic = True
.Underline = wdUnderlineSingle
.UnderlineColor = wdColorAutomatic
.Strikethrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 16
.Animation = wdAnimationNone
End With
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.HomeKey Unit:=wdLine
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.MoveLeft Unit:=wdCharacter, Count:=2
.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
.Selection.MoveUp Unit:=wdLine, Count:=1
.Selection.MoveDown Unit:=wdLine, Count:=6, Extend:=wdExtend
With .Selection.Font
.Name = "Bookman Old Style"
.Size = 11
.Bold = False
.Italic = True
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.Strikethrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.MoveUp Unit:=wdLine, Count:=1
.ActiveWindow.ActivePane.SmallScroll Down:=-30
.Selection.MoveUp Unit:=wdLine, Count:=5
.Selection.HomeKey Unit:=wdLine
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.MoveLeft Unit:=wdCharacter, Count:=2
.Selection.MoveRight Unit:=wdCharacter, Count:=26, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveRight Unit:=wdCharacter, Count:=9
.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.MoveLeft Unit:=wdCharacter, Count:=37
.Selection.MoveRight Unit:=wdCharacter, Count:=2
.Selection.MoveLeft Unit:=wdCharacter, Count:=1
.Selection.MoveRight Unit:=wdCharacter, Count:=11, Extend:=wdExtend
.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveRight Unit:=wdCharacter, Count:=9
.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.MoveLeft Unit:=wdCharacter, Count:=39
.Selection.MoveRight Unit:=wdCharacter, Count:=2
.Selection.MoveRight Unit:=wdCharacter, Count:=14, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveRight Unit:=wdCharacter, Count:=10
.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.HomeKey Unit:=wdLine
.Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
.Selection.Font.Bold = wdToggle
.Selection.MoveUp Unit:=wdLine, Count:=2
.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End With
Sleep 1000
' Me conecto a la BD
Cnx.ConnectionString = "dsn=demoLab"
Cnx.Open
Sql = "select * from informeDetalles where numeroBiopsia =" & biopsia & ""
Rst.Open Sql, Cnx, adOpenDynamic, adLockBatchOptimistic
' Genero Informe ********************** PRUEBA **********************
With objWord
.Selection.Font.Italic = True
.Selection.Font.Underline = wdUnderlineSingle
.Selection.Font.Name = "Times New Roman"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText "Estudio Anatomo-Patologico"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText "Examen Macroscopico:"
.Selection.Font.Underline = wdUnderlineNone
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Name = "Bookman Old Style"
Do While Not Rst.EOF
.Selection.Font.Underline = wdUnderlineSingle
.Selection.Font.Bold = wdToggle
.Selection.TypeText Rst!tipoMuestra + ", " + Rst!tituloMuestra
.Selection.Font.Underline = wdUnderlineNone
.Selection.Font.Bold = wdToggle
.Selection.TypeParagraph
.Selection.TypeText Rst!descripcionCompleta
.Selection.TypeParagraph
.Selection.TypeParagraph
Rst.MoveNext
Loop
Rst.Close
End With
objWord.ActiveDocument.Save
If Report Then
objWord.Application.Visible = True
Else
objWord.Application.Quit
End If
Cnx.Close
End Function

ahora hay veces que lo hace bien y otras veces lo hace al reves, como por ejemplo dentro del encabezado coloca cosas del informe que no deberían ir o hay veces que coloca pie de página cuando no la estoy pidiendo a que se debe esto ?!

Hola
Prueba poniendo el objeto word siempre delante. Por ejemplo:

En vez de
.ActiveWindow…
poner
objWord.ActiveWindow..

en vez de
.Selection…
poner
objWord.Selection…

en vez de
.ActiveDocument.
poner
objWord.ActiveDocument…

así tienes que hacerlo también en este caso:

en vez de
If .ActiveWindow.ActivePane.View.Type = wdNormalView Or .ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
Poner
If objWord.ActiveWindow.ActivePane.View.Type = wdNormalView Or objWord.ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then