Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-13-2021, 06:57 AM
Lup Lup is offline Problem with "OpenAsDocument" Windows 10 Problem with "OpenAsDocument" Office 2013
Novice
Problem with "OpenAsDocument"
 
Join Date: Jul 2018
Location: Finland and Spain
Posts: 15
Lup is on a distinguished road
Default Problem with "OpenAsDocument"

I have a Word macro that cleans up the styles attached to a document. It goes through all the styles and deletes all that are not built-in, in use, or present in the template attached to the document. It works OK, But:
It is necessary to open the template as a document to get at the Styles collection in it. That causes the template to pop up as a document on the screen. Quite an annoyance! Initially, it also screwed up the whole macro as it made the template the ActiveDocument, which didn't suit other procedures. That's now taken care of.
But how do I the template removed from the screen? Or made invisible?
_Lup
Reply With Quote
  #2  
Old 04-13-2021, 02:42 PM
macropod's Avatar
macropod macropod is offline Problem with "OpenAsDocument" Windows 10 Problem with "OpenAsDocument" Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For example:
Code:
Sub StyleCleaner()
Dim wdDocA As Document, wdDocB As Document, Stl As Style, StrStl As String
Set wdDocA = ActiveDocument: StrStl = "|"
With wdDocA
  Set wdDocB = Documents.Open(FileName:=.AttachedTemplate.FullName, AddToRecentFiles:=False, Visible:=False)
  With wdDocB
    For Each Stl In .Styles
      If Stl.BuiltIn = False Then StrStl = StrStl & Stl.NameLocal & "|"
    Next
    .Close False
  End With
  For Each Stl In .Styles
    With Stl
      If .BuiltIn = False Then
        If .InUse = False Then
          If InStr(StrStl, "|" & .NameLocal & "|") = 0 Then .Delete
        End If
      End If
    End With
  Next
End With
MsgBox "All Done.", vbOKOnly
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 04-13-2021, 06:04 PM
Guessed's Avatar
Guessed Guessed is offline Problem with "OpenAsDocument" Windows 10 Problem with "OpenAsDocument" Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Looking at Paul's code it is important to note that the .InUse property of a style is essentially useless as it returns TRUE if the style was ever used in the document or template. It doesn't reflect whether the style is currently in use in the document. To see if the style is currently being used in the document we need to do a find as a secondary test.
Code:
Sub RemoveStyles()
  'Searches main story of current document and deletes all unused User-Defined Styles
  Dim msg As String, DelMsg As String, myDoc As Document, sty As Variant
  
  Set myDoc = ActiveDocument
  msg = "Styles in use:" & vbCr
  DelMsg = "Styles deleted:" & vbCr
  For Each sty In myDoc.Styles
    If sty.InUse = True Then
      With myDoc.Content.Find
        .ClearFormatting
        .Text = ""
        .Style = sty
        .Execute Format:=True
        If .Found = True Then
          msg = msg & sty & ", "
        Else
          If sty.BuiltIn Then GoTo Catcher
          DelMsg = DelMsg & sty & ", "
          sty.Delete
        End If
      End With
    End If
Catcher:
  Next sty
  MsgBox msg & vbCr & vbCr & DelMsg
End Sub
Lup
You need to reduce ambiguity by assigning ActiveDocument to a variable before you start your search in the AttachedTemplate. The way I've approached the same requirement is to open the template and load the stylenames to a dictionary object before looping through the styles in ActiveDocument. As the code fragment in the below instance sits in the AttachedTemplate, I used ThisDocument to identify the template.
Code:
  Set aDocDirty = ActiveDocument
  aDocDirty.UpdateStyles    'make sure all template styles included before beginning
  
  WordBasic.DisableAutoMacros 1   'Disables auto macros
    Set aDoc = Documents.Add(Template:=ThisDocument.FullName)
  WordBasic.DisableAutoMacros 0   'Enables auto macros
  
  'build dictionary of template custom stylenames
  Set dictTemplateStyles = New Scripting.Dictionary
  For Each aSty In aDoc.Styles
    Select Case aSty.Type
      Case wdStyleTypeCharacter, wdStyleTypeLinked, wdStyleTypeParagraph, wdStyleTypeParagraphOnly
        If Not aSty.BuiltIn Then
          sName = Split(aSty.NameLocal, ",")(0)
          dictTemplateStyles.Add sName, aSty.NameLocal    'namelocal includes existing aliases
          'Debug.Print sName, dictTemplateStyles(sName)
        End If
    End Select
  Next aSty
  Debug.Print "Number of custom styles in template: " & dictTemplateStyles.Count
  aDoc.Close SaveChanges:=False
  
  Set dictMap = GetDictMap(aDocDirty)
  Debug.Print dictMap.Count

  'Now iterate through aDocDirty styles
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #4  
Old 04-13-2021, 06:47 PM
macropod's Avatar
macropod macropod is offline Problem with "OpenAsDocument" Windows 10 Problem with "OpenAsDocument" Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by Guessed View Post
Looking at Paul's code it is important to note that the .InUse property of a style is essentially useless as it returns TRUE if the style was ever used in the document or template. It doesn't reflect whether the style is currently in use in the document. To see if the style is currently being used in the document we need to do a find as a secondary test.
In which case, to do it comprehensively:
Code:
Sub StyleCleaner()
Application.ScreenUpdating = False
Dim wdDocA As Document, wdDocB As Document, Stl As Style, StrStl As String, bHid As Boolean
bHid = ActiveWindow.View.ShowHiddenText
ActiveWindow.View.ShowHiddenText = True
Set wdDocA = ActiveDocument: StrStl = "|"
With wdDocA
  Set wdDocB = Documents.Open(FileName:=.AttachedTemplate.FullName, AddToRecentFiles:=False, Visible:=False)
  With wdDocB
    For Each Stl In .Styles
      If Stl.BuiltIn = False Then StrStl = StrStl & Stl.NameLocal & "|"
    Next
    .Close False
  End With
  For Each Stl In .Styles
    With Stl
      If .BuiltIn = False Then
        If .InUse = False Then
          If InStr(StrStl, "|" & .NameLocal & "|") = 0 Then
            .Delete
          Else
            Call DelUnusedStyle(wdDocA, .NameLocal)
          End If
        End If
      End If
    End With
  Next
End With
Set wdDocA = Nothing: Set wdDocB = Nothing
ActiveWindow.View.ShowHiddenText = bHid
Application.ScreenUpdating = True
MsgBox "All Done.", vbOKOnly
End Sub

Sub DelUnusedStyle(Doc As Document, StlNm As String)
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter, Shp As Shape, bDel As Boolean
bDel = True
With Doc
  'Loop through all story ranges
  For Each Rng In .StoryRanges
    bDel = Not bFnd(Rng, StlNm)
    If bDel = False Then Exit For
  Next
  'Loop through all headers & footers
  For Each Sctn In .Sections
    If bDel = False Then Exit For
    For Each HdFt In Sctn.Headers
      If bDel = False Then Exit For
      With HdFt
        If .Exists = True Then
          If (Sctn.Index = 1) Or (.LinkToPrevious = False) Then
            bDel = Not bFnd(HdFt.Range, StlNm)
            If bDel = False Then Exit For
            For Each Shp In .Shapes
              If bDel = False Then Exit For
              If Not Shp.TextFrame Is Nothing Then bDel = Not bFnd(Shp.TextFrame.TextRange, StlNm)
            Next
          End If
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      If bDel = False Then Exit For
      With HdFt
        If .Exists = True Then
          If (Sctn.Index = 1) Or (.LinkToPrevious = False) Then
            bDel = Not bFnd(HdFt.Range, StlNm)
            If bDel = False Then Exit For
            For Each Shp In .Shapes
              If bDel = False Then Exit For
              If Not Shp.TextFrame Is Nothing Then bDel = Not bFnd(Shp.TextFrame.TextRange, StlNm)
            Next
          End If
        End If
      End With
    Next
  Next
  If bDel = True Then .Styles(StlNm).Delete
End With
End Sub

Function bFnd(Rng As Range, StlNm As String) As Boolean
With Rng.Find
  .ClearFormatting
  .Forward = True
  .Format = True
  .Style = StlNm
  .Wrap = wdFindContinue
  .Execute
  bFnd = .Found
End With
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 04-14-2021, 12:43 AM
Lup Lup is offline Problem with "OpenAsDocument" Windows 10 Problem with "OpenAsDocument" Office 2013
Novice
Problem with "OpenAsDocument"
 
Join Date: Jul 2018
Location: Finland and Spain
Posts: 15
Lup is on a distinguished road
Default

Macropod and Guessed,
Thanks for your response. I got my questions answered and learned a lot more, in addition.
_Lup
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
typing "scr" and problem with "extending selection" danielmatt Word 16 07-21-2019 12:31 PM
extract email from google search "help" please " i can pay no problem after test" mohamedabdu Excel Programming 1 08-22-2018 07:43 PM
remove repeated words with " macro " or " wild cards " in texts with parentheses and commas jocke321 Word VBA 2 12-10-2014 11:27 AM
Problem with "OpenAsDocument" Problem with "Next page" section break automatically turning into "Odd or Even Page" c_gallagher25 Word 1 02-12-2014 04:27 PM
Problem with "OpenAsDocument" How to choose a "List" for certain "Heading" from "Modify" tool? Jamal NUMAN Word 2 07-03-2011 03:11 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:27 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft