Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
[blue]selection.Information(wdActiveEndPageNumber)[/blue]
[blue]selection.Information(wdFirstCharacterLineNumber)[/blue]
[blue]Sub StylesinUse()
Dim sty As Style
Dim strStyleList As Collection
Dim j As Integer
Dim intFileNum As Integer
Dim strTempFilename As String
Dim filenameprint As String
Dim oDoc As Document
filenameprint = ActiveDocument.Name
[green]' Set strStyleList = New Collection NOT NEEDED ANY MORE[/green]
[green]' Moved from below [/green]
strTempFilename = "C:\" + filenameprint + "_Styles in Use.doc"
Set oDoc = New Document
[green]' Re-activate your original doc [/green]
Documents(filenameprint).Activate
For Each sty In ActiveDocument.Styles
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles(sty)
.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
' Style type is tested with it's value rather than the wdStyleTypeList
' constant because it is not declared in Word 97.
If Selection.Find.Found = True And sty.Type <> 4 Then
[green]' Write out to new doc here - including page and line number
' Reactivate original doc - to be perfectly honest I don't see why this should be needed ... but it is
' And remove the adding to the collection[/green]
oDoc.Content.InsertAfter sty.NameLocal & _
vbTab & "Page " & Selection.Information(wdActiveEndPageNumber) & _
vbTab & "Line " & Selection.Information(wdFirstCharacterLineNumber) & vbNewLine
Documents(filenameprint).Activate
[green] ' strStyleList.Add Item:=sty[/green]
End If
Next sty
[green]' Now done before the Find loop
'strTempFilename = "C:\Styles in Use\" + filenameprint + "_Styles in Use.doc"
'Set oDoc = New Document[/green]
oDoc.SaveAs FileName:=strTempFilename, FileFormat:=wdFormatDocument
[green]' oDoc.Close ' Don't Close Yet[/green]
[green]' Get rid of all this process
' Set oDoc = Nothing
' intFileNum = FreeFile
' Open strTempFilename For Output Access Write As intFileNum
' Print #intFileNum, "Styles in Use in FILE ", filenameprint
' Print #intFileNum,
' Print #intFileNum,
' For j = 1 To strStyleList.Count
' Print #intFileNum, strStyleList(j)
' Next j
' Close intFileNum
[/green]
'printout/save file
[green]' Not closed - no need to re-open
' Set oDoc = Documents.Open(FileName:=strTempFilename)
[/green]
Rem If MsgBox("Do you want to print out the document?" & vbCrLf & "Click Yes to Print out. Click No to Save to a file.", vbYesNo) = vbYes Then
Rem oDoc.PrintOut
oDoc.Activate
ActiveDocument.SaveAs FileName:=strTempFilename
oDoc.Close
Set oDoc = Nothing
Rem Kill strTempFilename
End Sub[/blue]