J
Jean-Guy Marcil
Hi there,
I have a client who want a report his employees uses to have a facility
whereby they can switch to landscape or back to portrait at the click of a
button.
The difficulty is that there are 3 header/footer (the template is built with
three basic sections), but luckily, they are all of the primary type...
Otherwise, what a nightmare it would have been!
There is
a Title page section (No landscape there...)
a main section (Can be landscape)
an annex section (Can be landscape)
So I have the code to go to landscape covering most situations (Where is the
cursor located?, Is there a page/section break already? etc,) I just have to
add a little option to let users decides if they want to use the current
page or add a new page with a landscape orientation.
Then, all I will need to do is "reverse engineer" my own code to give users
the possibility of returning a section to a portrait orientation...
So here is the thing:
I have a template. I did not want to bloat it or mess it up, so I created a
document from the said template and experimented with my landscape code in
that document VBA project modules.
The code is included below....
At the end of the day I noticed that the code was running a bit slower... I
figured that I kept adding all kinds of checks all day, it was to be
expected. But when I hit over 20 seconds, and then nearly 60 seconds.... I
thought this was not normal.
It was sporadic though. Sometimes if I quit Word and started over it was OK,
other times I noticed that I could make things worse by undoing everything
after each run of the code, then it would be an exponential time increase...
Finally my document bloated from 900 Kb (Lots of logos and graphics) to 2.5
MB in one save...
That stank of corruption. So I created a new document, transferred the code
and everything was back to 2-3 seconds.
The question is:
Is there something in my code that is causing this, so that if users fool
around with lots of orientation changes my code will corrupt their document
or
Was it simply because I tried out all kinds of code with this document,
sometimes causing Word to crash. Did I create the corruption because of the
nature of the work I was doing (So my users will not have to worry about
that kind of corruption)
One time I noticed that the line
PageCount = ActiveDocument.Content _
.Information(wdNumberOfPagesInDocument)
took a really long time to process...
Again, is it because of that particular property being flaky, or was it due
to document corruption? Should I use
PageCount = Selection.Information(wdNumberOfPagesInDocument)
instead?
Thanks.
'_______________________________________
Sub FormatPaysage()
'To be added:
'Code to give users the option of either adding a landscape
'section after the current page or to turn the current page
'into a landscape orientation
'Now the code just adds a landscape section after the current page
Dim PageRange As Range
'To get page number where cursor is
Dim StartPage As Long
'To get section number following current section to be added
Dim CurSection As Long
'To get total number of page in document
Dim PageCount As Long
'To flag if current page is last in document
Dim IsLastPage As Boolean
'If user wants to add a page or not after the last one
Dim NotAddPage As Boolean
'This variable will control where and how the landscape section
'is added if user or environement dictates it
Dim AdjustSection As Long
'This is used to flag if current page already has a section
'break at the end
Dim AddSectionBreak
'This is used to flag if current page has a page break at the end
Dim RemovePageBreak As Boolean
'This is to indicate which Autotext to use in the header
Dim AutoTextHeader As String
'This is to flag whether we are dealing with the first
'section of the Annexe
Dim FirstAnnexe As Boolean
'To store the First annexe section numnber
Dim FirstAnnexeSectionNumber As Long
'Variables needed for the message box in case cursor
'is on last page
Dim LastPageOrNot As String
Dim Style As Variant
Dim Title As String
Dim Response As Variant
LastPageOrNot = "Voulez-vous ajouter une page en format paysage " _
& " à la toute fin du document?" & vbCrLf & _
"Si vous répondez ""Non"", il n'y aura pas de " _
& "page ""Portrait"" après celle-ci."
Style = vbYesNo + vbExclamation + vbDefaultButton1
Title = "Dernière page"
'initialize variables
AddSectionBreak = False
RemovePageBreak = False
NotAddPage = False
IsLastPage = False
FirstAnnexe = False
AdjustSection = 1
PageCount = ActiveDocument.Content _
.Information(wdNumberOfPagesInDocument)
StartPage = Selection _
.Information(wdActiveEndPageNumber)
'Evaluate if currently on last page
If StartPage = PageCount Then
IsLastPage = True
Response = MsgBox(LastPageOrNot, Style, Title)
If Response = vbNo Then
NotAddPage = True
'So that changes are not carried back one section
AdjustSection = 0
Else
AddSectionBreak = True
End If
End If
'Get starting range and move cursor if at very end of document
'otherwise next line generates an error
Selection.Collapse
If Selection.Start = ActiveDocument.Content.End - 1 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End If
Set PageRange = Selection.Bookmarks("\Page").Range
'Check if finishes with section break if not on last page
If Not IsLastPage Then
If Not HasBreak(PageRange.Duplicate, "^b") Then
AddSectionBreak = True
'Check if current page finishes with page break
'It is assumed that if the last two characters of the page range
'have a section break,
'then there is no page break, this is why this test is embedded here,
'(it will not be necessary if HasSectionBreak is true)
If HasBreak(PageRange.Duplicate, "^m") Then
RemovePageBreak = True
End If
End If
End If
'Add first section break
With PageRange
'Remove page break if present
If RemovePageBreak Then
With .Duplicate
.MoveEnd Unit:=wdCharacter, Count:=-1
.Collapse Direction:=wdCollapseEnd
.Expand Unit:=wdCharacter
.Delete
End With
End If
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
End With
'If user does not want to add an extra page at the end of the document,
'do not add a section break...
If Not NotAddPage Then
'If page already has a section break at the end, only add a ¶
With PageRange
If AddSectionBreak Then
.InsertParagraphAfter
.Paragraphs(1).Style = "corps 10/20"
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
Else
.MoveEnd Unit:=wdCharacter, Count:=-1
.InsertParagraphAfter
.Paragraphs(1).Style = "corps 10/20"
.MoveEnd Unit:=wdCharacter, Count:=2
.Collapse Direction:=wdCollapseEnd
End If
End With
End If
'Get section number after the one we just inserted
CurSection = PageRange.Sections.Item(1).Index
'Evaluate which Autotext to use for the Header
FirstAnnexeSectionNumber = FirstAnnexeHeader
If CurSection > FirstAnnexeSectionNumber Then
AutoTextHeader = "Paysage2"
'If we are changing the first section of the Annexe in landscape,
'we will loose the bookmark "PremierAnnexe",
'so it has to be replaced
ElseIf CurSection = FirstAnnexeSectionNumber Then
AutoTextHeader = "Paysage2"
'To replace the bookamrk
'Code to be produced
Else
AutoTextHeader = "Paysage1"
FirstAnnexe = True
End If
'Unlink following section so as to preserve its header/footer
With ActiveDocument.Sections(CurSection)
With .Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
End With
With .Footers(wdHeaderFooterPrimary)
.LinkToPrevious = False
End With
End With
'Make target section Landscape
With ActiveDocument.Sections(CurSection - AdjustSection).PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1.18)
.BottomMargin = InchesToPoints(0.79)
.LeftMargin = InchesToPoints(1.28)
.RightMargin = InchesToPoints(2.26)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.49)
.FooterDistance = InchesToPoints(0.64)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
End With
'Unlink target section from previous one so as to preserve the
'previous section's header/footer (It may be redundant if the target
'section is the last one of the document... but it does not matter,
'we can unlink again...)
'Also, add new Header/footer
With ActiveDocument.Sections(CurSection - AdjustSection)
With .Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
Set PageRange = .Range
ActiveDocument.AttachedTemplate. _
AutoTextEntries(AutoTextHeader).Insert _
Where:=PageRange, RichText:=True
PageRange.InsertParagraphAfter
PageRange.Collapse wdCollapseEnd
ActiveDocument.AttachedTemplate. _
AutoTextEntries("Paysage-Pied").Insert _
Where:=PageRange, RichText:=True
End With
With .Footers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
End With
End With
'Go to new landscape section
'To be skipped if users wants to change current section to landscape
Application.Browser.Next
Set PageRange = Nothing
End Sub
'_______________________________________
'_______________________________________
Function HasBreak(RangeToCheck As Range, SearchStr As String) As Boolean
'Check if last character in range is a section/page break
Selection.Find.ClearFormatting
With RangeToCheck
.MoveStart Unit:=wdCharacter, Count:=.Characters.Count - 2
With .Find
.Text = SearchStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute
If .Found Then
HasBreak = True
Else
HasBreak = False
End If
End With
End With
Selection.Find.ClearFormatting
Selection.Find.Text = ""
Application.Browser.Target = wdBrowsePage
Set RangeToCheck = Nothing
End Function
'_______________________________________
'_______________________________________
Function FirstAnnexeHeader() As Long
'To find the section number containing the Bookmark "PremierAnnexe"
'so as to know which Autotext to use
Dim StRange As Range
Dim MyBkm As Bookmark
FirstAnnexeHeader = 0
For Each StRange In ActiveDocument.StoryRanges
If StRange.StoryType = wdPrimaryHeaderStory Then
While Not (StRange.NextStoryRange Is Nothing)
Set StRange = StRange.NextStoryRange
For Each MyBkm In StRange.Bookmarks
If MyBkm.Name = "PremierAnnexe" Then
FirstAnnexeHeader = StRange.Sections _
.Item(1).Index
Exit For
End If
Next MyBkm
If FirstAnnexeHeader <> 0 Then Exit For
Wend
End If
Next StRange
Set StRange = Nothing
End Function
'_______________________________________
TIA
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org
I have a client who want a report his employees uses to have a facility
whereby they can switch to landscape or back to portrait at the click of a
button.
The difficulty is that there are 3 header/footer (the template is built with
three basic sections), but luckily, they are all of the primary type...
Otherwise, what a nightmare it would have been!
There is
a Title page section (No landscape there...)
a main section (Can be landscape)
an annex section (Can be landscape)
So I have the code to go to landscape covering most situations (Where is the
cursor located?, Is there a page/section break already? etc,) I just have to
add a little option to let users decides if they want to use the current
page or add a new page with a landscape orientation.
Then, all I will need to do is "reverse engineer" my own code to give users
the possibility of returning a section to a portrait orientation...
So here is the thing:
I have a template. I did not want to bloat it or mess it up, so I created a
document from the said template and experimented with my landscape code in
that document VBA project modules.
The code is included below....
At the end of the day I noticed that the code was running a bit slower... I
figured that I kept adding all kinds of checks all day, it was to be
expected. But when I hit over 20 seconds, and then nearly 60 seconds.... I
thought this was not normal.
It was sporadic though. Sometimes if I quit Word and started over it was OK,
other times I noticed that I could make things worse by undoing everything
after each run of the code, then it would be an exponential time increase...
Finally my document bloated from 900 Kb (Lots of logos and graphics) to 2.5
MB in one save...
That stank of corruption. So I created a new document, transferred the code
and everything was back to 2-3 seconds.
The question is:
Is there something in my code that is causing this, so that if users fool
around with lots of orientation changes my code will corrupt their document
or
Was it simply because I tried out all kinds of code with this document,
sometimes causing Word to crash. Did I create the corruption because of the
nature of the work I was doing (So my users will not have to worry about
that kind of corruption)
One time I noticed that the line
PageCount = ActiveDocument.Content _
.Information(wdNumberOfPagesInDocument)
took a really long time to process...
Again, is it because of that particular property being flaky, or was it due
to document corruption? Should I use
PageCount = Selection.Information(wdNumberOfPagesInDocument)
instead?
Thanks.
'_______________________________________
Sub FormatPaysage()
'To be added:
'Code to give users the option of either adding a landscape
'section after the current page or to turn the current page
'into a landscape orientation
'Now the code just adds a landscape section after the current page
Dim PageRange As Range
'To get page number where cursor is
Dim StartPage As Long
'To get section number following current section to be added
Dim CurSection As Long
'To get total number of page in document
Dim PageCount As Long
'To flag if current page is last in document
Dim IsLastPage As Boolean
'If user wants to add a page or not after the last one
Dim NotAddPage As Boolean
'This variable will control where and how the landscape section
'is added if user or environement dictates it
Dim AdjustSection As Long
'This is used to flag if current page already has a section
'break at the end
Dim AddSectionBreak
'This is used to flag if current page has a page break at the end
Dim RemovePageBreak As Boolean
'This is to indicate which Autotext to use in the header
Dim AutoTextHeader As String
'This is to flag whether we are dealing with the first
'section of the Annexe
Dim FirstAnnexe As Boolean
'To store the First annexe section numnber
Dim FirstAnnexeSectionNumber As Long
'Variables needed for the message box in case cursor
'is on last page
Dim LastPageOrNot As String
Dim Style As Variant
Dim Title As String
Dim Response As Variant
LastPageOrNot = "Voulez-vous ajouter une page en format paysage " _
& " à la toute fin du document?" & vbCrLf & _
"Si vous répondez ""Non"", il n'y aura pas de " _
& "page ""Portrait"" après celle-ci."
Style = vbYesNo + vbExclamation + vbDefaultButton1
Title = "Dernière page"
'initialize variables
AddSectionBreak = False
RemovePageBreak = False
NotAddPage = False
IsLastPage = False
FirstAnnexe = False
AdjustSection = 1
PageCount = ActiveDocument.Content _
.Information(wdNumberOfPagesInDocument)
StartPage = Selection _
.Information(wdActiveEndPageNumber)
'Evaluate if currently on last page
If StartPage = PageCount Then
IsLastPage = True
Response = MsgBox(LastPageOrNot, Style, Title)
If Response = vbNo Then
NotAddPage = True
'So that changes are not carried back one section
AdjustSection = 0
Else
AddSectionBreak = True
End If
End If
'Get starting range and move cursor if at very end of document
'otherwise next line generates an error
Selection.Collapse
If Selection.Start = ActiveDocument.Content.End - 1 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End If
Set PageRange = Selection.Bookmarks("\Page").Range
'Check if finishes with section break if not on last page
If Not IsLastPage Then
If Not HasBreak(PageRange.Duplicate, "^b") Then
AddSectionBreak = True
'Check if current page finishes with page break
'It is assumed that if the last two characters of the page range
'have a section break,
'then there is no page break, this is why this test is embedded here,
'(it will not be necessary if HasSectionBreak is true)
If HasBreak(PageRange.Duplicate, "^m") Then
RemovePageBreak = True
End If
End If
End If
'Add first section break
With PageRange
'Remove page break if present
If RemovePageBreak Then
With .Duplicate
.MoveEnd Unit:=wdCharacter, Count:=-1
.Collapse Direction:=wdCollapseEnd
.Expand Unit:=wdCharacter
.Delete
End With
End If
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
End With
'If user does not want to add an extra page at the end of the document,
'do not add a section break...
If Not NotAddPage Then
'If page already has a section break at the end, only add a ¶
With PageRange
If AddSectionBreak Then
.InsertParagraphAfter
.Paragraphs(1).Style = "corps 10/20"
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
Else
.MoveEnd Unit:=wdCharacter, Count:=-1
.InsertParagraphAfter
.Paragraphs(1).Style = "corps 10/20"
.MoveEnd Unit:=wdCharacter, Count:=2
.Collapse Direction:=wdCollapseEnd
End If
End With
End If
'Get section number after the one we just inserted
CurSection = PageRange.Sections.Item(1).Index
'Evaluate which Autotext to use for the Header
FirstAnnexeSectionNumber = FirstAnnexeHeader
If CurSection > FirstAnnexeSectionNumber Then
AutoTextHeader = "Paysage2"
'If we are changing the first section of the Annexe in landscape,
'we will loose the bookmark "PremierAnnexe",
'so it has to be replaced
ElseIf CurSection = FirstAnnexeSectionNumber Then
AutoTextHeader = "Paysage2"
'To replace the bookamrk
'Code to be produced
Else
AutoTextHeader = "Paysage1"
FirstAnnexe = True
End If
'Unlink following section so as to preserve its header/footer
With ActiveDocument.Sections(CurSection)
With .Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
End With
With .Footers(wdHeaderFooterPrimary)
.LinkToPrevious = False
End With
End With
'Make target section Landscape
With ActiveDocument.Sections(CurSection - AdjustSection).PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1.18)
.BottomMargin = InchesToPoints(0.79)
.LeftMargin = InchesToPoints(1.28)
.RightMargin = InchesToPoints(2.26)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.49)
.FooterDistance = InchesToPoints(0.64)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
End With
'Unlink target section from previous one so as to preserve the
'previous section's header/footer (It may be redundant if the target
'section is the last one of the document... but it does not matter,
'we can unlink again...)
'Also, add new Header/footer
With ActiveDocument.Sections(CurSection - AdjustSection)
With .Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
Set PageRange = .Range
ActiveDocument.AttachedTemplate. _
AutoTextEntries(AutoTextHeader).Insert _
Where:=PageRange, RichText:=True
PageRange.InsertParagraphAfter
PageRange.Collapse wdCollapseEnd
ActiveDocument.AttachedTemplate. _
AutoTextEntries("Paysage-Pied").Insert _
Where:=PageRange, RichText:=True
End With
With .Footers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
End With
End With
'Go to new landscape section
'To be skipped if users wants to change current section to landscape
Application.Browser.Next
Set PageRange = Nothing
End Sub
'_______________________________________
'_______________________________________
Function HasBreak(RangeToCheck As Range, SearchStr As String) As Boolean
'Check if last character in range is a section/page break
Selection.Find.ClearFormatting
With RangeToCheck
.MoveStart Unit:=wdCharacter, Count:=.Characters.Count - 2
With .Find
.Text = SearchStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute
If .Found Then
HasBreak = True
Else
HasBreak = False
End If
End With
End With
Selection.Find.ClearFormatting
Selection.Find.Text = ""
Application.Browser.Target = wdBrowsePage
Set RangeToCheck = Nothing
End Function
'_______________________________________
'_______________________________________
Function FirstAnnexeHeader() As Long
'To find the section number containing the Bookmark "PremierAnnexe"
'so as to know which Autotext to use
Dim StRange As Range
Dim MyBkm As Bookmark
FirstAnnexeHeader = 0
For Each StRange In ActiveDocument.StoryRanges
If StRange.StoryType = wdPrimaryHeaderStory Then
While Not (StRange.NextStoryRange Is Nothing)
Set StRange = StRange.NextStoryRange
For Each MyBkm In StRange.Bookmarks
If MyBkm.Name = "PremierAnnexe" Then
FirstAnnexeHeader = StRange.Sections _
.Item(1).Index
Exit For
End If
Next MyBkm
If FirstAnnexeHeader <> 0 Then Exit For
Wend
End If
Next StRange
Set StRange = Nothing
End Function
'_______________________________________
TIA
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org
