VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} WordCountAllDlg 
   Caption         =   "WordCountAll"
   ClientHeight    =   5625
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4260
   OleObjectBlob   =   "WordCountAllDlg.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "WordCountAllDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' *****************************
' * WordCountAll
' * Counts words and double-byte characters (e.g. Japanese) in
' * body and textboxes
' *
' * Copyright (c) 2001 Ryan Ginstrom
' *
' * You are free to do anything you want to this macro except sell it.
' * No warranties, not suitable for any particular purpose, etc. etc.
' *
' * 3/14/2004 -- Added count for double-byte characters
' * 9/20/2004 -- Changed to template with custom form
' *****************************

Private NumWords As Long
Private NumCharsNoSpaces As Long
Private NumCharsWithSpaces As Long
Private NumDoubleByteChars As Long

Private Sub AllDocsCheckBox_Click()

    DoCount

End Sub

Private Sub CommentsCheckBox_Click()

    DoCount
    

End Sub

Private Sub EndnotesCheckBox_Click()
    
    DoCount

End Sub

Private Sub FootersCheckBox_Click()

    DoCount

End Sub

Private Sub FootnotesCheckBox_Click()

    DoCount

End Sub

Private Sub HeadersCheckBox_Click()
    
    DoCount

End Sub

Private Sub MainTextCheckBox_Click()
    
    DoCount

End Sub

Private Sub OKButton_Click()
    
    Unload Me
    
End Sub

Private Sub TextboxesCheckBox_Click()
    
    DoCount

End Sub

Private Sub UngroupTextBoxesButton_Click()
   
    If vbNo = MsgBox("This may alter the anchor points of your text boxes/shapes." _
                        & vbCrLf _
                        & "It is recommended that you work from a backup copy if you choose this option." _
                        & vbCrLf & vbCrLf _
                        & "Proceed?", _
                        vbYesNo, _
                        "Warning: Possible Damge to File") Then
        Exit Sub
    End If
    
    
    While UngroupBoxes = True
    Wend

    UngroupTextBoxesButton.Enabled = False
    
    If TextboxesCheckBox = True Then
    
        DoCount

    End If
    
End Sub

Private Sub DoCount()

    InitVariables

    If AllDocsCheckBox Then
        BatchWordCount
    Else
        WordCountAll
    End If
    
    ReportWordCount

End Sub

Public Sub InitVariables()
     NumWords = 0
     NumCharsNoSpaces = 0
     NumCharsWithSpaces = 0
     NumDoubleByteChars = 0
End Sub

Public Sub BatchWordCount()

    Dim oDoc As Document
    
    For Each oDoc In Application.Documents
    
        oDoc.Activate
        
        WordCountAll
        
    Next oDoc


End Sub

'==========================
Public Sub WordCountAll()

    ' Turn off screen updating
    Application.ScreenUpdating = False
    
        Selection.Collapse
    
        Dim oStory As Range
        
            For Each oStory In ActiveDocument.StoryRanges
            
                Select Case oStory.StoryType
                
                    Case wdCommentsStory
                        
                        If CommentsCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                        
                    Case wdEndnotesStory
                        
                        If EndnotesCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                        
                    Case wdEvenPagesFooterStory, wdFirstPageFooterStory, wdPrimaryFooterStory
                        
                        If FootersCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                        
                    Case wdEvenPagesHeaderStory, wdFirstPageHeaderStory, wdPrimaryHeaderStory
                        
                        If HeadersCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                        
                    Case wdFootnotesStory
                        
                        If FootnotesCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                        
                    Case wdMainTextStory
                        
                        If MainTextCheckBox = True Then
                            AddToBodyCount oStory
                        End If
                    
                End Select
                
                    
            Next oStory
    
            If TextboxesCheckBox = True Then
                TextBoxCount
            End If
            
    ' Turn on screen updating
    Application.ScreenUpdating = True

End Sub

Private Sub AddToBodyCount(ByRef oBody As Range)

    Dim oDialog As Object
    
    On Error Resume Next
    
    With Dialogs(wdDialogToolsWordCount)
        .Update
    
        oBody.Select
    
        .Execute
            
        NumWords = NumWords + .Words
        NumCharsWithSpaces = NumCharsWithSpaces + .charactersincludingspaces
        NumCharsNoSpaces = NumCharsNoSpaces + .Characters
        NumDoubleByteChars = NumDoubleByteChars + .DBCs
            
        If Err.Number <> 0 Then
            StatusBar = "Error trying to retrieve DBC count: " & Err.Description
            Err.Clear
        End If
        
    End With

End Sub


Private Sub ReportWordCount()
    
    ' Show the word count
    
   WordsValue = Format(NumWords, "###,###,##0")
   CharsNoSpacesValue = Format(NumCharsNoSpaces, "###,###,##0")
   CharsWithSpacesValue = Format(NumCharsWithSpaces, "###,###,##0")
   SingleByteWordsValue = Format(NumWords - NumDoubleByteChars, "###,###,##0")
   DoubleByteCharsValue = Format(NumDoubleByteChars, "###,###,##0")
  
    
End Sub


Private Function TextBoxCount() As Integer

    
    On Error Resume Next
    With Dialogs(wdDialogToolsWordCount)
    
        .Update
        
        Dim oShape As Object
        For Each oShape In ActiveDocument.Shapes
        
            oShape.Select
        
            If oShape.Type = msoTextBox Then
                .Execute
                
                NumWords = NumWords + .Words
                NumCharsWithSpaces = NumCharsWithSpaces + .charactersincludingspaces
                NumCharsNoSpaces = NumCharsNoSpaces + .Characters
                NumDoubleByteChars = NumDoubleByteChars + .DBCs
                    
                If Err.Number <> 0 Then
                    StatusBar = "Error trying to retrieve DBC count: " & Err.Description
                    Err.Clear
                End If
            End If
                
            Next oShape
    
    End With
    
End Function

Private Function BoxesAreGrouped() As Boolean
    
    BoxesAreGrouped = False

    Dim shpTemp As Object
    
    If AllDocsCheckBox = True Then
    
        Dim oDoc As Document
    
        For Each oDoc In Application.Documents

            
            For Each shpTemp In ActiveDocument.Shapes
                If shpTemp.Type = msoGroup Then
                    BoxesAreGrouped = True
                    Exit Function
                End If
            Next shpTemp

        Next oDoc
    
    Else
    
        
        For Each shpTemp In ActiveDocument.Shapes
            If shpTemp.Type = msoGroup Then
                BoxesAreGrouped = True
                Exit Function
            End If
        Next shpTemp

    End If
    
End Function


Private Function UngroupBoxes() As Boolean
    
    UngroupBoxes = False

    Dim shpTemp As Object
            
    If AllDocsCheckBox = True Then
    
        Dim oDoc As Document
    
        For Each oDoc In Application.Documents

            For Each shpTemp In ActiveDocument.Shapes
                If shpTemp.Type = msoGroup Then
                    shpTemp.Ungroup
                    UngroupBoxes = True
                End If
            Next shpTemp

        Next oDoc
    
    Else
    
        For Each shpTemp In ActiveDocument.Shapes
            If shpTemp.Type = msoGroup Then
                shpTemp.Ungroup
                UngroupBoxes = True
            End If
        Next shpTemp

    End If

End Function


Private Sub UserForm_Activate()

    If BoxesAreGrouped Then
        UngroupTextBoxesButton.Enabled = True
    Else
        UngroupTextBoxesButton.Enabled = False
    End If
        
    DoCount

End Sub