Get the number of pages in a Word document - vba

I am making lots of changes to a Word document using automation, and then running a VBA macro which - among other things - checks that the document is no more than a certain number of pages.
I'm using ActiveDocument.Information(wdNumberOfPagesInDocument) to get the number of pages, but this method is returning an incorrect result. I think this is because Word has not yet updated the pagination of the document to reflect the changes that I've made.
ActiveDocument.ComputeStatistics(wdStatisticPages) also suffers from the same issue.
I've tried sticking in a call to ActiveDocument.Repaginate, but that makes no difference.
I did have some luck with adding a paragraph to the end of the document and then deleting it again - but that hack seems to no longer work (I've recently moved from Word 2003 to Word 2010).
Is there any way I can force Word to actually repaginate, and/or wait until the repagination is complete?

I just spent a good 2 hours trying to solve this, and I have yet to see this answer on any forum so I thought I would share it.
https://msdn.microsoft.com/en-us/vba/word-vba/articles/pages-object-word?f=255&MSPPError=-2147217396
That gave me my solution combined with combing through the articles to find that most of the solutions people reference are not supported in the newest versions of Word. I don't know what version it changed in, but my assumption is that 2013 and newer can use this code to count pages:
ActiveDocument.ActiveWindow.Panes(1).Pages.Count.
I believe the way this works is ActiveDocument selects the file, ActiveWindow confirms that the file to be used is in the current window (in case the file is open in multiple windows from the view tab), Panes determines that if there is multiple windows/split panes/any other nonsense you want the "first" one to be evaluated, pages.count designates the pages object to be evaluated by counting the number of items in the collection.
Anyone more knowledgeable feel free to correct me, but this is the first method that gave me the correct page count on any document I tried!
Also I apologize but I cant figure out how to format that line into a code block. If the mods want to edit my comment to do that be my guest.

Try (maybe after ActiveDocument.Repaginate)
ActiveDocument.BuiltinDocumentProperties(wdPropertyPages)
It is causing my Word 2010 to spend half-second with "Counting words" status in status bar, while ActiveDocument.ComputeStatistics(wdStatisticPages) returns the result immediately.
Source: https://support.microsoft.com/en-us/kb/185509

After you've made all your changes, you can use OnTime to force a slight delay before reading the page statistics.
Application.OnTime When:=Now + TimeValue("00:00:02"), _
Name:="UpdateStats"
I would also update all the fields before this OnTime statement:
ActiveDocument.Range.Fields.Update

I found a possible workaround below, if not a real answer to the topic question.
Yesterday, the first ComputeStatistics line below was returning the correct total of 31 pages, but today it returns only 1.
The solution is to get rid of the Content object and the correct number of pages is returned.
Dim docMultiple As Document
Set docMultiple = ActiveDocument
lPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) ' Returns 1
lPageCount = docMultiple.ComputeStatistics(wdStatisticPages) ' Returns correct count, 31

ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
This works every time for me. It returns total physical pages in the word.

I used this from within Excel
it worked reliably on about 20 documents
none were longer than 20 pages but some were quite complex
with images and page breaks etc.
Sub GetlastPageFromInsideExcel()
Set wD = CreateObject("Word.Application")
Set myDoc = wD.Documents.Open("C:\Temp\mydocument.docx")
myDoc.Characters.Last.Select ' move to end of document
wD.Selection.Collapse ' collapse selection at end
lastPage = wD.Selection.Information(wdActiveEndPageNumber)
mydoc.close
wd.quit
Set wD = Nothing
End Sub

One problem I had in getting "ComputeStatistics" to return a correct page count was that I often work in "Web Layout" view in Word. Whenever you start Word it reverts to the last view mode used. If Word was left in "Web Layout" mode "ComputeStatistics" returned a page count of "1" page for all files processed by the script. Once I specifically set "Print Layout" view I got the correct page counts.
For example:
$MSWord.activewindow.view.type = 3 # 3 is 'wdPrintView', 6 is 'wdWebView'
$Pages = $mydoc.ComputeStatistics(2) # 2 is 'wdStatisticPages'

You can use Pages-Object and its properties such as Count. It works perfect;)
Dim objPages As Pages
Set objPage = ActiveDocument.ActiveWindow.Panes(1).Pages
QuantityOfPages = ActiveDocument.ActiveWindow.Panes(1).Pages.Count

Dim wordapp As Object
Set wordapp = CreateObject("Word.Application")
Dim doc As Object
Set doc = wordapp.Documents.Open(oFile.Path)
Dim pagesCount As Integer
pagesCount = doc.Content.Information(4) 'wdNumberOfPagesInDocument
doc.Close False
Set doc = Nothing

Related

Run-time error '5852' when iterating over revisions

I am easily annoyed by word tracking format changes (even in text that is newly inserted in a revision), so I am using a macro to accept all format changes, once they summed up:
Sub AcceptAllFormatChanges()
Dim xRev As Revision
Dim count As Integer
count = 0
For Each xRev In ActiveDocument.Revisions
If Not xRev Is Nothing Then
If xRev.Type = wdRevisionProperty Then
count = count + 1
xRev.Accept
End If
End If
Next xRev
MsgBox ("Accepted " & count & " format changes")
End Sub
This works fine most of the time, but on some documents, it gives me a run-time error '5852' - Requested object is not available on the "If xRev.Type" line. I am looking for a way to check the object that is yielded by ActiveDocument.Revisions without it throwing a run-time error. Checking for Nothing is not enough. The issue also occures when removing the xRev.Accept or when looping backwards through the revisions.
Update: I tracked down the issue to a Word Bug today. If the macro strikes, I am also unable to iterate through changes in the document using the Next Change button on the review panel. Additionally, if I open the revision panel, the number of revisions jumps back and forth between two numbers. This helped me track down those ghost revisions to a few insertions which included fields (references to other sections). I am able to correct those by deleting/reinserting, so at least now I know how to fix my documents to make the macro work again. Unfortunately, I cannot reproduce the bug in order to actually file a bug report.
The VBA question though remains open: Is there a way for the macro to skip those ghost revisions without throwing a run-time error?
Use the WdRevisionType enumeration instead of cryptic numbers in the code for checking the Type property. Also you may try to check for Nothing before getting the Type property value. The following code works like a charm for me:
Public Sub AcceptSelection()
Dim rev As Revision
For Each rev In Selection.Range.Revisions
rev.Accept
Next rev
End Sub
And the last resort is to replace the for each loop with a reverse for loop.

VB.Net equivalent for (CustomizationContext) in VBA

I'm busy with some word automation and have run into an issue whereby a context menu within a document has items in, that I wish to remove.
Once the document is open, through vba I can remove these items by running the following code;
[VBA]
Dim oContextMenu As CommandBar
Dim oContextMenuItem As CommandBarControl
'Make changes to the ActiceDocument only (this is needed to make any changes to this document).
CustomizationContext = ActiveDocument
For Each oContextMenu In ActiveDocument.CommandBars
If oContextMenu.Type = MsoBarType.msoBarTypePopup Then 'Loop through all the context menus of type (msoBarTypePopup)
For Each oContextMenuItem In oContextMenu.Controls
If (InStr(oContextMenuItem.Caption, "Smokeball")) Then
oContextMenuItem.Delete
End If
Next
End If
Next
If I execute this code and check the document, all contextMenu sub items that contain the text "smokeball" are removed.
When I try move this code to my VB.NET solution (I have no choice of language, so VB it is), I get errors on the CustomizationContext = ActiveDocument line (this line has to be there for it to affect the current document).
The error I get is CustomizationContext' is not a by reference property.
Does anyone know how to get just that ONE line equivalent for vb.net?
Thanks in advance.
EDIT: In case you need to see the vb.net sub:
Private Sub RemoveUnwantedContextMenuItems()
Dim oContextMenu As CommandBar
Dim oContextMenuItem As CommandBarControl
'Make changes to the ActiceDocument only (this is needed to make any changes to this document).
WordApplication.CustomizationContext = WordApplication.ActiveDocument 'This is the error.
For Each oContextMenu In WordApplication.CommandBars
If oContextMenu.Type = MsoBarType.msoBarTypePopup Then 'Loop through all the context menus of type (msoBarTypePopup)
For Each oContextMenuItem In oContextMenu.Controls
If (InStr(oContextMenuItem.Caption, "Smokeball")) Then
oContextMenuItem.Delete()
End If
Next
End If
Next
End Sub
PS - I have also already tried using the .AttachedTemplate as well as .Normal / .NormalTemplate
Jules pointed me in the right direction with his sample code.
After lots of playing around I noticed that somewhere in the solution, the [TYPE] of WordApplication was getting changed to a dynamic type of sorts, hence, it couldn't use CustomizationContext.
My solution was this:
I changed this line;
WordApplication.CustomizationContext = WordApplication.ActiveDocument
To this:
CType(WordApplication, Microsoft.Office.Interop.Word.Application).CustomizationContext = WordApplication.ActiveDocument
Forcing the types to be correct.
Simple solution but took some time.
Thanks to Jules for pointing me in the right direction.
(Points should go to you).

How to find and disable a content control by tag to delete it and its contents?

I have the unfortunate task of being forced to design a Word-based electronic production card for the unit at my company, even though I've never worked with VBA. I would much rather have done this in Excel since I wouldn't have to wrestle with content control and hard-to-find locations in various tables over the pages, but the company's documentation-system forces this particular one to be in Word.
My issue is that for proper form of the production card I need to use tables, and I need the production card to be dynamic to limit its size to what operations that are relevant for a specific order. My chosen solution is to create a full form, and to use a user form/prompt where they can choose which parts to use and which parts to ommit, and the ommitted ones will then be deleted. Part of reason for the solution is because that is how their previous (and Excel-based) production card works, so it would make it more familiar for the end user.
Because MS Word is finicky I need to use content control within these tables to not have the end user accidentally destroy half of it, but after a full workday I still cannot figure out how find and shut off the content control of the cells in tables that I want to delete. I do have the content controls tagged since that seems like the only reasonable way to find them.
This is my current code for the subprocedure, but for some reason I cannot get the ID through the ccID line, even though I have verified that the string supplied as argument is correct.
Private Sub DeleteCCByTag(ccTag As String)
Dim cc As ContentControl
Dim ccID As String
ccID = ThisDocument.SelectContentControlsByTag(ccTag).Item(1).ID
'MsgBox ccID 'Debug prompt
Set cc = ThisDocument.ContentControls(ccID)
cc.LockContentControl = False
cc.LockContents = False
cc.Delete (False)
End Sub
First of all- your code is working find for me but...
ContentControls tag is case-sensitive which could be a problem in your situation
You could solve your problem without searching for ID value in this way:
Private Sub DeleteCCByTag_Alternative(ccTag As String)
Dim cc As ContentControl
Set cc = ThisDocument.SelectContentControlsByTag(ccTag).Item(1)
With cc
.LockContentControl = False
.LockContents = False
.Range.Delete 'to delete CC content
.Delete (False)
End With
End Sub
CC.Delete in your code deletes only ContentControl objects itself but not its content. To delete content you need to add additional line which I did in my code above.
I would add this as a comment to KazJaw's answer but I don't have the rep.
According to Microsoft's documentation, if you pass True to the Delete method it removes both the content control and its contents.
So: just get the Item as KazJaw showed, without jumping through the hoop of getting its ID:
Set cc = ThisDocument.SelectContentControlsByTag(ccTag).Item(1)
then call .Delete(True) on it.

How to remove the recent document history in Excel Ribbon using VBA

How to remove the recent document history in Excel Ribbon using VBA.
I am using the code below, but it doesn't seems to work.
Sub Button1_Click()
For i = 1 To Application.RecentFiles.Count - 1
Application.RecentFiles(i).Delete
Next i
End Sub
Thanks ...
To clear the list of recently used files, and not mess with the user's settings, the following code will work:
originalSetting = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 0
Application.RecentFiles.Maximum = originalSetting
This will remove the recent files and then reset the maximum number of recent files back to whatever the user had initially.
If you just want to remove them individually, you can step through them in reverse order to get the job done.
Dim i As Integer
For i = Application.RecentFiles.Count To 1 Step -1
Application.RecentFiles.Item(i).Delete
Next
You need to run from the bottom of the collection up, because as soon as you delete one of the entries from the RecentFiles collection, all of the indexes of the remaining files change. This way, each time through the loop, you are deleting the last item in the collection.
And also, since this collection is Base 1 instead of Base 0, the last item in the collection is Application.RecentFiles.Count rather than .RecentFiles.Count-1.
I just love all those little inconsistencies in Excel.. :)
There is no direct mechanism for hiding the most recently used file listing. It can be done, however, by setting the Application.RecentFiles.Maximum to zero (0).
For a detailed discussion, see Change the Ribbon in Excel 2007 by Ron de Bruin, and scroll down to the section titled "Dictator examples and Hide the MRU ('Most Recently Used') file list", with code provided by Jim Rech.
This can also be done manually. See: How to Clear and Delete Recent Documents List in Office 2007 (Word, Excel, PowerPoint).
-- Mike
To clear the activeworkbook from the list of recentfiles use this:
Sub DeleteFileFromRecentFiles()
Dim i As Integer
For Each RecentFile In Application.RecentFiles
If ActiveWorkbook.Name = RecentFile.Name Then
i = i + 1
Application.RecentFiles.Item(i).Delete
End If
Next
End Sub
Sincerely,
Richard

GetCrossReferenceItems in msword and VBA showing only limited content

I want to make a special list of figures with use of VBA and here I am using the function
myFigures = ActiveDocument.GetCrossReferenceItems(Referencetype:="Figure")
In my word document there are 20 figures, but myFigures only contains the first 10 figures (see my code below.).
I search the internet and found that others had the same problem, but I have not found any solutions.
My word is 2003 version
Please help me ....
Sub List()
Dim i As Long
Dim LowerValFig, UpperValFig As Integer
Dim myTables, myFigures as Variant
If ActiveDocument.Bookmarks.Count >= 1 Then
myFigures = ActiveDocument.GetCrossReferenceItems(Referencetype:="Figure")
' Test size...
LowerValFig = LBound(myFigures) 'Get the lower boundry number.
UpperValFig = UBound(myFigures) 'Get the upper boundry number
' Do something ....
For i = LBound(myFigures) To UBound(myFigures) ‘ should be 1…20, but is onlu 1…10
'Do something ....
Next i
End If
MsgBox ("Done ....")
End Sub*
Definitely something flaky with that. If I run the following code on a document that contains 32 Figure captions, the message boxes both display 32. However, if I uncomment the For Next loop, they only display 12 and the iteration ceases after the 12th item.
Dim i As Long
Dim myFigures As Variant
myFigures = ActiveDocument.GetCrossReferenceItems("Figure")
MsgBox myFigures(UBound(myFigures))
MsgBox UBound(myFigures)
'For i = 1 To UBound(myFigures)
' MsgBox myFigures(i)
'Next i
I had the same problem with my custom cross-refference dialog and solved it by invoking the dialog after each command ActiveDocument.GetCrossReferenceItems(YourCaptionName).
So you type:
varRefItemsFigure1 = ActiveDocument.GetCrossReferenceItems(g_strCaptionLabelFigure1)
For k = 1 To UBound(varRefItemsFigure1)
frmBwtRefDialog.ListBoxFigures.AddItem varRefItemsFigure1(k)
Next
and then:
frmBwtRefDialog.Show vbModeless
Thus the dialog invoked several times instead of one, but it works fast and don't do any trouble. I used this for one year and didn't see any errors.
Enjoy!
Frankly I feel bad about calling this an "answer", but here's what I did in the same situation. It would appear that entering the debugger and stepping through the GetCrossReferenceItems always returns the correct value. Inspired by this I tried various ways of giving control back to Word (DoEvents; running next segment using Application.OnTime) but to no avail. Eventually the only thing I found that worked was to invoke the debugger between assignments, so I have:
availRefs =
ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem):Stop
availTables =
ActiveDocument.GetCrossReferenceItems(wdCaptionTable):Stop
availFigures = ActiveDocument.GetCrossReferenceItems(wdCaptionFigure)
It's not pretty but, as I'm the only person who'll be running this, it kind of works for my purposes.