Count the number of deleted manual page breaks
in [Word VBA]
|
Prev: Clearing variables
Next: Setting options in Word
From: andreas on 30 Jan 2010 12:30 Dear Experts: below macros deletes all existing manual page breaks before paragraphs formatted with built-in heading style 1. The macro works fine. I now would like to count the number of manual page breaks deleted immediately before headings level 1 and display it in a Message Box. How do I have to re-write the code to achieve this? Help is much appreciated. Thank you very much in advance. Regards, Andreas Sub DelPageBreakBefHd1() Dim rgeDoc As Range Set rgeDoc = ActiveDocument.Range If MsgBox("Deletion of all manual page breaks before headings level 1?'" & vbCrLf & _ "Would you like to continue?", vbYesNo + vbQuestion, "Deletion of manual page breaks before Heading 1") = vbNo Then Exit Sub End If Set rng = ActiveDocument.Range With rng.Find .Style = ActiveDocument.Styles(wdStyleHeading1) ' Search from Beginning of Document .Forward = True 'Find only one occurrence .Wrap = wdFindStop .Format = True If Not .Execute() Then MsgBox "No paragraph formatted with Heading level 1 style in current document." & vbCrLf & vbCrLf & _ "Please make sure that at least one heading is formatted with 'Heading 1" & vbCrLf & vbCrLf & _ "Macro will exit!", vbCritical, "no paragraph found with heading style 'Heading 1'" Exit Sub End If End With Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory) With rngStory.Find .Text = "^m" .MatchWildcards = False ' .Replacement.Text = "" While .Execute i = i + 1 rngStory.Collapse wdCollapseEnd Wend End With ' Loop Until rngStory Is Nothing If i = 0 Then MsgBox "No Manual Page Breaks found!", vbCritical, "No Manual Page Breaks" End If Exit Sub With rgeDoc.Find .Text = "^m" While .Execute If .Parent.Next.Paragraphs(1).Range.Style = _ ActiveDocument.Styles(wdStyleHeading1) Then .Parent.Delete End If Wend End With Application.Browser.Target = wdBrowsePage End Sub
From: ARAHII on 30 Jan 2010 13:35 Andreas, Your code demonstrates lots of code writing talent, so maybe I don't understand your question, here's my suggestion. In front of the last loop (e.g., before With rgeDoc.Find) insert count = 0 'not necessary if local variable and only used below Inside the if of the last loop (e.g., after .Parent.Delete) insert count = count + 1 Before the end of the sub (e.g., after the End With of With rgeDoc.Find) insert MsgBox "number of manual page breaks deleted: " & count -- Art ___________________________________ Arthur R. Hendrickson, Jr. DRS CONSOLIDATED CONTROLS, INC "andreas" wrote: > Dear Experts: > > below macros deletes all existing manual page breaks before paragraphs > formatted with built-in heading style 1. > The macro works fine. > > I now would like to count the number of manual page breaks deleted > immediately before headings level 1 and display it in a Message Box. > How do I have to re-write the code to achieve this? > > Help is much appreciated. Thank you very much in advance. Regards, > Andreas > > > > Sub DelPageBreakBefHd1() > > > Dim rgeDoc As Range > > > Set rgeDoc = ActiveDocument.Range > > > If MsgBox("Deletion of all manual page breaks before headings level > 1?'" & vbCrLf & _ > "Would you like to continue?", vbYesNo + vbQuestion, "Deletion of > manual page breaks before Heading 1") = vbNo Then > Exit Sub > End If > > > Set rng = ActiveDocument.Range > With rng.Find > .Style = ActiveDocument.Styles(wdStyleHeading1) > ' Search from Beginning of Document > .Forward = True > 'Find only one occurrence > .Wrap = wdFindStop > .Format = True > If Not .Execute() Then > > MsgBox "No paragraph formatted with Heading level 1 style > in current document." & vbCrLf & vbCrLf & _ > "Please make sure that at least one heading is formatted > with 'Heading 1" & vbCrLf & vbCrLf & _ > "Macro will exit!", vbCritical, "no paragraph found with > heading style 'Heading 1'" > Exit Sub > End If > End With > > > > Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory) > With rngStory.Find > .Text = "^m" > .MatchWildcards = False > ' .Replacement.Text = "" > While .Execute > i = i + 1 > rngStory.Collapse wdCollapseEnd > Wend > End With > ' Loop Until rngStory Is Nothing > If i = 0 Then > MsgBox "No Manual Page Breaks found!", vbCritical, "No Manual Page > Breaks" > End If > Exit Sub > > > With rgeDoc.Find > .Text = "^m" > While .Execute > If .Parent.Next.Paragraphs(1).Range.Style = _ > ActiveDocument.Styles(wdStyleHeading1) Then > .Parent.Delete > End If > Wend > End With > > > > Application.Browser.Target = wdBrowsePage > > > End Sub > . >
From: Doug Robbins - Word MVP on 30 Jan 2010 16:19 Replace With rgeDoc.Find .Text = "^m" While .Execute If .Parent.Next.Paragraphs(1).Range.Style = _ ActiveDocument.Styles(wdStyleHeading1) Then .Parent.Delete End If Wend End With with i = 0 With rgeDoc.Find .Text = "^m" While .Execute If .Parent.Next.Paragraphs(1).Range.Style = _ ActiveDocument.Styles(wdStyleHeading1) Then .Parent.Delete i = i + 1 End If Wend End With Msgbox i & " manual page breaks have been deleted." -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP, originally posted via msnews.microsoft.com "andreas" <andreas.hermle(a)gmx.de> wrote in message news:6e6e6938-2996-422f-8ead-81ab74e10d6b(a)21g2000yqj.googlegroups.com... > Dear Experts: > > below macros deletes all existing manual page breaks before paragraphs > formatted with built-in heading style 1. > The macro works fine. > > I now would like to count the number of manual page breaks deleted > immediately before headings level 1 and display it in a Message Box. > How do I have to re-write the code to achieve this? > > Help is much appreciated. Thank you very much in advance. Regards, > Andreas > > > > Sub DelPageBreakBefHd1() > > > Dim rgeDoc As Range > > > Set rgeDoc = ActiveDocument.Range > > > If MsgBox("Deletion of all manual page breaks before headings level > 1?'" & vbCrLf & _ > "Would you like to continue?", vbYesNo + vbQuestion, "Deletion of > manual page breaks before Heading 1") = vbNo Then > Exit Sub > End If > > > Set rng = ActiveDocument.Range > With rng.Find > .Style = ActiveDocument.Styles(wdStyleHeading1) > ' Search from Beginning of Document > .Forward = True > 'Find only one occurrence > .Wrap = wdFindStop > .Format = True > If Not .Execute() Then > > MsgBox "No paragraph formatted with Heading level 1 style > in current document." & vbCrLf & vbCrLf & _ > "Please make sure that at least one heading is formatted > with 'Heading 1" & vbCrLf & vbCrLf & _ > "Macro will exit!", vbCritical, "no paragraph found with > heading style 'Heading 1'" > Exit Sub > End If > End With > > > > Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory) > With rngStory.Find > .Text = "^m" > .MatchWildcards = False > ' .Replacement.Text = "" > While .Execute > i = i + 1 > rngStory.Collapse wdCollapseEnd > Wend > End With > ' Loop Until rngStory Is Nothing > If i = 0 Then > MsgBox "No Manual Page Breaks found!", vbCritical, "No Manual Page > Breaks" > End If > Exit Sub > > > With rgeDoc.Find > .Text = "^m" > While .Execute > If .Parent.Next.Paragraphs(1).Range.Style = _ > ActiveDocument.Styles(wdStyleHeading1) Then > .Parent.Delete > End If > Wend > End With > > > > Application.Browser.Target = wdBrowsePage > > > End Sub
From: andreas on 31 Jan 2010 03:47 On Jan 30, 10:19 pm, "Doug Robbins - Word MVP" <d...(a)REMOVECAPSmvps.org> wrote: > Replace > > With rgeDoc.Find > .Text = "^m" > While .Execute > If .Parent.Next.Paragraphs(1).Range.Style = _ > ActiveDocument.Styles(wdStyleHeading1) Then > .Parent.Delete > End If > Wend > End With > > with > > i = 0 > With rgeDoc.Find > .Text = "^m" > While .Execute > If .Parent.Next.Paragraphs(1).Range.Style = _ > ActiveDocument.Styles(wdStyleHeading1) Then > .Parent.Delete > i = i + 1 > End If > Wend > End With > Msgbox i & " manual page breaks have been deleted." > > -- > Hope this helps. > > Please reply to the newsgroup unless you wish to avail yourself of my > services on a paid consulting basis. > > Doug Robbins - Word MVP, originally posted via msnews.microsoft.com > > "andreas" <andreas.her...(a)gmx.de> wrote in message > > news:6e6e6938-2996-422f-8ead-81ab74e10d6b(a)21g2000yqj.googlegroups.com... > > > > > Dear Experts: > > > below macros deletes all existing manual page breaks before paragraphs > > formatted with built-in heading style 1. > > The macro works fine. > > > I now would like to count the number of manual page breaks deleted > > immediately before headings level 1 and display it in a Message Box. > > How do I have to re-write the code to achieve this? > > > Help is much appreciated. Thank you very much in advance. Regards, > > Andreas > > > Sub DelPageBreakBefHd1() > > > Dim rgeDoc As Range > > > Set rgeDoc = ActiveDocument.Range > > > If MsgBox("Deletion of all manual page breaks before headings level > > 1?'" & vbCrLf & _ > > "Would you like to continue?", vbYesNo + vbQuestion, "Deletion of > > manual page breaks before Heading 1") = vbNo Then > > Exit Sub > > End If > > > Set rng = ActiveDocument.Range > > With rng.Find > > .Style = ActiveDocument.Styles(wdStyleHeading1) > > ' Search from Beginning of Document > > .Forward = True > > 'Find only one occurrence > > .Wrap = wdFindStop > > .Format = True > > If Not .Execute() Then > > > MsgBox "No paragraph formatted with Heading level 1 style > > in current document." & vbCrLf & vbCrLf & _ > > "Please make sure that at least one heading is formatted > > with 'Heading 1" & vbCrLf & vbCrLf & _ > > "Macro will exit!", vbCritical, "no paragraph found with > > heading style 'Heading 1'" > > Exit Sub > > End If > > End With > > > Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory) > > With rngStory.Find > > .Text = "^m" > > .MatchWildcards = False > > ' .Replacement.Text = "" > > While .Execute > > i = i + 1 > > rngStory.Collapse wdCollapseEnd > > Wend > > End With > > ' Loop Until rngStory Is Nothing > > If i = 0 Then > > MsgBox "No Manual Page Breaks found!", vbCritical, "No Manual Page > > Breaks" > > End If > > Exit Sub > > > With rgeDoc.Find > > .Text = "^m" > > While .Execute > > If .Parent.Next.Paragraphs(1).Range.Style = _ > > ActiveDocument.Styles(wdStyleHeading1) Then > > .Parent.Delete > > End If > > Wend > > End With > > > Application.Browser.Target = wdBrowsePage > > > End Sub- Hide quoted text - > > - Show quoted text - Hi Doug, that's it! Thank you very much for your professional help. Regards, Andreas
From: andreas on 31 Jan 2010 03:51 On Jan 30, 7:35 pm, ARAHII <ARA...(a)discussions.microsoft.com> wrote: > Andreas, > > Your code demonstrates lots of code writing talent, so maybe I don't > understand your question, here's my suggestion. > > In front of the last loop (e.g., before With rgeDoc.Find) insert > count = 0 'not necessary if local variable and only used below > > Inside the if of the last loop (e.g., after .Parent.Delete) insert > count = count + 1 > > Before the end of the sub (e.g., after the End With of With rgeDoc.Find) > insert > MsgBox "number of manual page breaks deleted: " & count > > -- > Art > ___________________________________ > Arthur R. Hendrickson, Jr. > DRS CONSOLIDATED CONTROLS, INC > > > > "andreas" wrote: > > Dear Experts: > > > below macros deletes all existing manual page breaks before paragraphs > > formatted with built-in heading style 1. > > The macro works fine. > > > I now would like to count the number of manual page breaks deleted > > immediately before headings level 1 and display it in a Message Box. > > How do I have to re-write the code to achieve this? > > > Help is much appreciated. Thank you very much in advance. Regards, > > Andreas > > > Sub DelPageBreakBefHd1() > > > Dim rgeDoc As Range > > > Set rgeDoc = ActiveDocument.Range > > > If MsgBox("Deletion of all manual page breaks before headings level > > 1?'" & vbCrLf & _ > > "Would you like to continue?", vbYesNo + vbQuestion, "Deletion of > > manual page breaks before Heading 1") = vbNo Then > > Exit Sub > > End If > > > Set rng = ActiveDocument.Range > > With rng.Find > > .Style = ActiveDocument.Styles(wdStyleHeading1) > > ' Search from Beginning of Document > > .Forward = True > > 'Find only one occurrence > > .Wrap = wdFindStop > > .Format = True > > If Not .Execute() Then > > > MsgBox "No paragraph formatted with Heading level 1 style > > in current document." & vbCrLf & vbCrLf & _ > > "Please make sure that at least one heading is formatted > > with 'Heading 1" & vbCrLf & vbCrLf & _ > > "Macro will exit!", vbCritical, "no paragraph found with > > heading style 'Heading 1'" > > Exit Sub > > End If > > End With > > > Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory) > > With rngStory.Find > > .Text = "^m" > > .MatchWildcards = False > > ' .Replacement.Text = "" > > While .Execute > > i = i + 1 > > rngStory.Collapse wdCollapseEnd > > Wend > > End With > > ' Loop Until rngStory Is Nothing > > If i = 0 Then > > MsgBox "No Manual Page Breaks found!", vbCritical, "No Manual Page > > Breaks" > > End If > > Exit Sub > > > With rgeDoc.Find > > .Text = "^m" > > While .Execute > > If .Parent.Next.Paragraphs(1).Range.Style = _ > > ActiveDocument.Styles(wdStyleHeading1) Then > > .Parent.Delete > > End If > > Wend > > End With > > > Application.Browser.Target = wdBrowsePage > > > End Sub > > .- Hide quoted text - > > - Show quoted text - Hi Arthur, thank you very much for your swift and professional help. It works just fine. The praise for my skills in coding go right to the experts of this and other forums that have contributed largely to the codes I am using. To name a few: Greg Maxey, Doug Robbins, Mr. Jamieson, Macropod, Jay Freedman and so forth. Regards, Andreas
|
Pages: 1 Prev: Clearing variables Next: Setting options in Word |