none
WordやOutlookで使用できる「スペルチェックと文章校正」の文法チェック結果をVBAから取得する方法はありますか RRS feed

  • 質問

  • お世話になります。Officeフォーラムよりこちらへ誘導頂きまして、こちらにて再質問させて頂きます。

    WordやOutlookにてスペルチェックと文章校正を行うと、対象の文書内にチェックに引っかかったものがあれば、以下のような画面が表示されます。

    この画面に表示されている、チェック対象の範囲とチェック対象文字列(上記だと”食べれます。”と”食べれます”の部分)とチェック理由(上記だと”「ら」抜き”)、および修正候補の一覧(上記だと”食べられます”)をVBAから取得することは可能でしょうか?

    チェック対象となった箇所(上記だと”食べれます。”)を取得することは、以下のコードにより出来ているのですが、具体的なチェック対象文字列や修正候補の一覧を取得するところで実行時エラー'4120'、「引数が正しくありません。」が発生してしまっております(pErrors.Item(i).GetSpellingSuggestionsに対しCountプロパティを取得しようとしたところで発生)。

    Sub GrammaticalErrosTest()
        
        Dim pErrors As ProofreadingErrors
        Dim iCount As Integer
        Dim i, m As Integer
        
        Set pErrors = ActiveDocument.GrammaticalErrors
        iCount = pErrors.Count
        
        If iCount = 0 Then
            Debug.Print "ミスはありません。"
        Else
            Debug.Print "ミスがあります。"
            
            For i = 1 To iCount
                ' ↓は取得できます。
                Debug.Print "修正対象:" & pErrors.Item(i).Text
                ' ↓の行で実行時エラー'4120'、「引数が正しくありません。」が発生します。
                For m = 1 To pErrors.Item(i).GetSpellingSuggestions.Count
                    Debug.Print "修正候補:" & pErrors.Item(i).GetSpellingSuggestions.Item(m)
                Next
            Next
            
        End If
        
    End Sub

    MSDNでGetSpellingSuggestionsを参照すると、指定可能な引数MainDictionaryやCustomDictionaryを指定する必要があるのかと思いはしているものの、具体的に何を指定すれば良いのか分からないでおります。

    試しに「Languages(wdJapanese).ActiveGrammarDictionary」をMainDictionaryに指定しても引数が正しくないといわれ、CustomeDictionaryにCustomDictionaries(1)を指定すると辞書が開けません、となってしまいます。

    ご存じの方がいらっしゃいましたら、お知恵をお借りできますでしょうか。

    よろしくお願いします

    2014年6月18日 3:52

回答

  • こんにちは。

    Public Sub SampleErr()
      Dim r As Word.Range
      Dim dic As Word.Dictionary
     
      '下記すべて[実行時エラー '4625':辞書を開くことができません。]
      'Dictionaryオブジェクトから取得した辞書ファイルのパスを直接指定してもエラー
      For Each r In ActiveDocument.GrammaticalErrors
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="Nihongo").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="日本語").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="Japanese").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:=wdJapanese).Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="Nihongo").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="日本語").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="Japanese").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:=wdJapanese).Count
        'Set dic = Application.Languages(r.LanguageID).ActiveGrammarDictionary
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:=dic).Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:=dic).Count
      Next
    End Sub

    のように色々指定してみましたが、いずれも日本語の場合は「辞書を開くことができません。」エラーになりました。
    英単語の場合は問題無かったので、言語関連の設定か何かに問題があるのだと思いますが、原因がよく分からなかったので別の方法を考えてみました。
    CommandBar(Grammar)にあるコントロールの中でIDが「0」のものを拾うマクロです。
    あまりキレイなコードではありませんが、とりあえず32ビット版のWord 2010とWord 2013ではチェック理由と修正候補を取得することができました。

    Public Sub Sample()
      Dim r As Word.Range, tmp As Word.Range
      Dim col As VBA.Collection
      Dim i As Long, j As Long
     
      Set tmp = Selection.Range
      For Each r In ActiveDocument.GrammaticalErrors
        For i = 1 To Len(r.Text)
          r.Characters(i).Select
          If ChkZeroIdControl("Grammar") = True Then
            Set col = ListZeroIdControl("Grammar")
            If col.Count > 0 Then
              For j = 1 To col.Count
                Debug.Print r.Text, col(j)
              Next
            End If
            Set col = Nothing
            Exit For
          End If
        Next
      Next
      tmp.Select
    End Sub
    
    Private Function ChkZeroIdControl(ByVal CommandBarName As String) As Boolean
      Dim ret As Boolean
      Dim c As CommandBarControl
     
      ret = False '初期化
      On Error Resume Next
      For Each c In Application.CommandBars(CommandBarName).Controls
        If c.ID = 0 Then
          ret = True
          Exit For
        End If
      Next
      On Error GoTo 0
      ChkZeroIdControl = ret
    End Function
    
    Private Function ListZeroIdControl(ByVal CommandBarName As String) As Collection
      Dim c As CommandBarControl
      Dim col As Collection
        
      Set col = New Collection
      On Error Resume Next
      For Each c In Application.CommandBars(CommandBarName).Controls
        If c.ID = 0 Then
          col.Add c.Caption
        End If
      Next
      On Error GoTo 0
      Set ListZeroIdControl = col
    End Function

    • 回答としてマーク なおふみ 2014年6月23日 2:57
    2014年6月20日 7:01

すべての返信

  • こんにちは。

    Public Sub SampleErr()
      Dim r As Word.Range
      Dim dic As Word.Dictionary
     
      '下記すべて[実行時エラー '4625':辞書を開くことができません。]
      'Dictionaryオブジェクトから取得した辞書ファイルのパスを直接指定してもエラー
      For Each r In ActiveDocument.GrammaticalErrors
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="Nihongo").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="日本語").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:="Japanese").Count
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:=wdJapanese).Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="Nihongo").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="日本語").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:="Japanese").Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:=wdJapanese).Count
        'Set dic = Application.Languages(r.LanguageID).ActiveGrammarDictionary
        'Debug.Print r.GetSpellingSuggestions(MainDictionary:=dic).Count
        'Debug.Print r.GetSpellingSuggestions(CustomDictionary:=dic).Count
      Next
    End Sub

    のように色々指定してみましたが、いずれも日本語の場合は「辞書を開くことができません。」エラーになりました。
    英単語の場合は問題無かったので、言語関連の設定か何かに問題があるのだと思いますが、原因がよく分からなかったので別の方法を考えてみました。
    CommandBar(Grammar)にあるコントロールの中でIDが「0」のものを拾うマクロです。
    あまりキレイなコードではありませんが、とりあえず32ビット版のWord 2010とWord 2013ではチェック理由と修正候補を取得することができました。

    Public Sub Sample()
      Dim r As Word.Range, tmp As Word.Range
      Dim col As VBA.Collection
      Dim i As Long, j As Long
     
      Set tmp = Selection.Range
      For Each r In ActiveDocument.GrammaticalErrors
        For i = 1 To Len(r.Text)
          r.Characters(i).Select
          If ChkZeroIdControl("Grammar") = True Then
            Set col = ListZeroIdControl("Grammar")
            If col.Count > 0 Then
              For j = 1 To col.Count
                Debug.Print r.Text, col(j)
              Next
            End If
            Set col = Nothing
            Exit For
          End If
        Next
      Next
      tmp.Select
    End Sub
    
    Private Function ChkZeroIdControl(ByVal CommandBarName As String) As Boolean
      Dim ret As Boolean
      Dim c As CommandBarControl
     
      ret = False '初期化
      On Error Resume Next
      For Each c In Application.CommandBars(CommandBarName).Controls
        If c.ID = 0 Then
          ret = True
          Exit For
        End If
      Next
      On Error GoTo 0
      ChkZeroIdControl = ret
    End Function
    
    Private Function ListZeroIdControl(ByVal CommandBarName As String) As Collection
      Dim c As CommandBarControl
      Dim col As Collection
        
      Set col = New Collection
      On Error Resume Next
      For Each c In Application.CommandBars(CommandBarName).Controls
        If c.ID = 0 Then
          col.Add c.Caption
        End If
      Next
      On Error GoTo 0
      Set ListZeroIdControl = col
    End Function

    • 回答としてマーク なおふみ 2014年6月23日 2:57
    2014年6月20日 7:01
  • お世話になっております。質問させて頂いたなおふみと申します。

    きぬあさ様、ご教示くださいまして誠にありがとうございます。

    ご記載頂いたコードを私の端末(Office2010)で試したところ、欲しかった情報をばっちりとることが出来ました。

    私はGrammaticalErrorsからしか攻めておらず、CommandBarsからとること自体、全く発想できませんでした。目から鱗です。

    重ねて御礼申し上げます。ありがとうございました!

    2014年6月23日 2:57
  • 本VBAの記述はOffice2016では使用できないようです。文章に誤りがある場合にOffice2013以前ではIDが0で取得していた情報がOffice2016では現れなくなってしまったことによるようです。ただし、表記のゆれのみは取得できるようです。もし解決策がございましたらお教えいただけませんでしょうか。よろしくお願いいたします。
    2017年8月22日 3:38