Toon posts:

VBA Word macro Style

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hallo allemaal,

Enkele dagen geleden kreeg ik de opdracht om een Word Macro aan te passen die draaide onde Word 2002 UK versie maar constant vast slaat onder de nederlandse versie.

De code loopt iedere keer vast op 1 regel die ik aangegeven heb in de onderstaande 2 stukken code:

Private Sub UpdateHeader(pgSetup As PageSetup, _
hdr As HeaderFooter, _
runHeadText As String, _
numType As Integer, _
numStyle As Integer, _
isRestartNums As Boolean)

Dim hdrTabs As TabStops
Dim hdrRng As Range
Dim rightEdge As Single, centerPt As Single
Dim fld As field
Dim pgNums As PageNumbers

rightEdge = pgSetup.PageWidth - pgSetup.LeftMargin - pgSetup.RightMargin
centerPt = rightEdge / 2#

'Initialize the header
hdr.LinkToPrevious = False
Set hdrRng = hdr.Range

With hdrRng
.Text = ""
.Style = "Header" <== Deze regel
For Each fld In .Fields
fld.Delete
Next fld
Set hdrTabs = .ParagraphFormat.TabStops
End With
hdrTabs.ClearAll
hdrTabs.Add Position:=rightEdge, Alignment:=wdAlignTabRight
Set pgNums = hdr.PageNumbers
If isRestartNums Then
pgNums.RestartNumberingAtSection = True
pgNums.StartingNumber = 1
Else
pgNums.RestartNumberingAtSection = False
End If
Select Case numType
Case ePageNumberBottomCenter
hdrRng.Text = vbTab & runHeadText
pgNums.NumberStyle = numStyle

Case ePageNumberTopCenter
hdrTabs.Add Position:=centerPt, Alignment:=wdAlignTabCenter
With hdrRng
.Text = vbTab
.Collapse wdCollapseEnd
ActiveDocument.Fields.Add Range:=hdrRng, Type:=wdFieldPage
pgNums.NumberStyle = numStyle
.MoveEnd
.InsertAfter vbTab & runHeadText
End With

Case ePageNumberTopRight
hdrTabs.Add Position:=rightEdge - 36, Alignment:=wdAlignTabRight
With hdrRng
.Text = vbTab & runHeadText & vbTab
.Collapse wdCollapseEnd
.Fields.Add Range:=hdrRng, Type:=wdFieldPage
End With
pgNums.NumberStyle = numStyle

Case Else 'numtype = none
hdrRng.Text = vbTab & runHeadText
End Select
End Sub

En in dit stuk code:

Private Sub UpdateFooter(pgSetup As PageSetup, _
ftr As HeaderFooter, _
runHeadText As String, _
numType As Integer, _
numStyle As Integer, _
isRestartNums As Boolean)

Dim ftrRng As Range
Dim fld As field
Dim pgNums As PageNumbers
Dim ftrTabs As TabStops
Dim theCenter As Single

theCenter = (pgSetup.PageWidth - pgSetup.LeftMargin - pgSetup.RightMargin) / 2#

'Initialize the footer
ftr.LinkToPrevious = False
Set ftrRng = ftr.Range
With ftrRng
.Text = "Footer Text"
.Style = "Header" <== Deze regel ook
End With
For Each fld In ftrRng.Fields
fld.Delete
Next fld
Set ftrTabs = ftrRng.ParagraphFormat.TabStops
With ftrTabs
.ClearAll
.Add Position:=theCenter, Alignment:=wdAlignTabCenter
End With
Set pgNums = ftr.PageNumbers

With pgNums
If isRestartNums Then
pgNums.RestartNumberingAtSection = True
pgNums.StartingNumber = 1
Else
pgNums.RestartNumberingAtSection = False
End If
End With
'Bottom center page numbering
If numType = ePageNumberBottomCenter Then
With ftrRng
.Text = vbTab
.Collapse wdCollapseEnd
.Fields.Add Range:=ftrRng, Type:=wdFieldPage
End With
pgNums.NumberStyle = numStyle
End If
End Sub

Wanneer de regels uitgecomment slaat de applicatie niet meer vast maar functioneert de pagina nummering niet zoals het moet.
Het probleem zit dus in de Header en Footer.

Kan iemand mij enig inzicht geven in de oorzaak van het problem.
Dat zou een hele opluchting zijn.