View Single Post
Old 04-22-2019, 05:03 AM
Charles Kenyon Charles Kenyon is offline Windows 10 Office 2016
Join Date: Mar 2012
Location: Sun Prairie, Wisconsin
Posts: 6,056
Charles Kenyon is a name known to allCharles Kenyon is a name known to allCharles Kenyon is a name known to allCharles Kenyon is a name known to allCharles Kenyon is a name known to allCharles Kenyon is a name known to all

Here are the macros. You may need to change the language to suit.

The first one deals with styles.

Sub StyleEnglishUK()
'   Written 21 March 2018
'   Charles Kenyon
'   Intended to set all styles to EnglishUK, proofing, not automatitically update
'   Language IDs
    Dim aStyle As Style
    On Error Resume Next ' Some styles have no language attribute and will give an error
    For Each aStyle In ActiveDocument.Styles
        Select Case aStyle.NameLocal
            Case "TOC 1", "TOC 2", "TOC 3", "TOC 4", "TOC 5", "TOC 6", "TOC 7", "TOC 8", "TOC 9"
                Let aStyle.AutomaticallyUpdate = True
            Case Else
                Let aStyle.AutomaticallyUpdate = False
        End Select
        aStyle.LanguageID = wdEnglishUK
        aStyle.NoProofing = False
    Next 'aStyle
    ActiveDocument.UpdateStylesOnOpen = False ' For information on using this line, see:
    On Error GoTo 0
End Sub
Here is the one for the language in the document.
Sub ProofingLanguageEnglishUKAllStory()    ' based on field updater by Greg Maxey
    ' Charles Kenyon 6 November 2018
    ' Changes proofing language to English UK in all stories of document
    ' Language IDs
    Dim rngStory As Word.range
    Dim lngValidate As Long ' do not know purpose of this
    Dim oShp As Shape
    lngValidate = ActiveDocument.Sections(1).Headers(1).range.StoryType
    For Each rngStory In ActiveDocument.StoryRanges
      'Iterate through all linked stories
        On Error Resume Next
        rngStory.LanguageID = wdEnglishUK
        Select Case rngStory.StoryType
          Case 6, 7, 8, 9, 10, 11
            If rngStory.ShapeRange.Count > 0 Then
              For Each oShp In rngStory.ShapeRange
                If oShp.TextFrame.HasText Then
                   oShp.TextFrame.TextRange.LanguageID = wdEnglishUK
                End If
            End If
          Case Else
            'Do Nothing
        End Select
        On Error GoTo 0
        'Get next linked story (if any)
        Set rngStory = rngStory.NextStoryRange
      Loop Until rngStory Is Nothing
End Sub
Install/Employ VBA Procedures (Macros) by Greg Maxey, MVP

Instructions for Installing Macros from Forums or Websites by Graham Mayor, MVP
Reply With Quote