エクセルのsetphonetic関数

質問

たとえば「和家 利代」をsetphonetic関数で振り仮名をつけると「ワイエ　リダイ」になりました。正しくは「ワケ　トシヨ」です。「和家」を「ワケ」と読ませるようにできるのでしょうか。

回答No.5

cj_mover

＃３-４、ｃｊです。連続の自己レスです。すみません。

お昼を食べている時に、また不備に気付いたので追加レスします。

なるべく > 簡易なもので < という意図で紹介した＃３ですが、
但し書きが必要なのを忘れていました。
実行時の条件として、対象（アクティブ）セルについて
　・ユーザーの手書きによるフリガナが設定されていないこと。
　・[フリガナの設定][種類]で全角カタカナを選んでいること
の２点が必須で、これに外れると無限ループになってしまいます。
対策を加えてもコードの文字数に大差ないので、
以下、対策済のものに差し替え、＃３-４の記述の廃棄をお願いします。
度々、失礼しました。

' ' /// フリガナを設定。実行の度に次の候補にて設定。

Sub Re8768439c()
Dim sS As String
Dim sD As String

　　With ActiveCell　'　※　必ず、対象セルをアクティブにしてから実行。

　　　　' ' フリガナを表示する
　　　　If Not .Phonetic.Visible Then .Phonetic.Visible = True

'　　　　' ' フリガナを 同じ行の指定列 にて 参照・表示する
'　　　　With .EntireRow.Cells(1, "C")　'　← "C" ？ 列を要指定
'　　　　　　If .FormulaLocal = "" Then .FormulaLocal = "=PHONETIC(" & ActiveCell.Address & ")"
'　　　　End With

　　　　' ' フリガナが設定されているか、判別
　　　　If .Phonetics.Count > 0 Then　'　フリガナが設定されているなら

　　　　　　' ' 現在設定されているフリガナ を 全角カタカナ で 取得
　　　　　　sS = StrConv(.Phonetic.Text, vbKatakana Or vbWide)

　　　　　　' ' Application.GetPhonetic メソッドで フリガナ第一候補 を取得
　　　　　　' ' セルの値（漢字？相当）を引数に
　　　　　　sD = Application.GetPhonetic(.Value)

　　　　　　' ' 現在のフリガナ と フリガナ候補 が 一致するまで
　　　　　　' ' または フリガナ候補 が 尽きるまで ループ
　　　　　　Do Until sD = sS Or sD = ""
　　　　　　　　sD = Application.GetPhonetic()　'　次のフリガナ候補　を取得
　　　　　　Loop

　　　　　　' ' 次のフリガナ候補　を取得
　　　　　　sD = Application.GetPhonetic()

　　　　　　If sD = "" Then　'　フリガナ候補 が 空の文字列 なら
　　　　　　　　.Phonetics.Delete　'　フリガナ設定を削除
　　　　　　Else　'　フリガナ候補 が 空 でなければ
　　　　　　　　.Phonetic.Text = sD　'　フリガナ候補 を フリガナに設定
　　　　　　End If

　　　　Else　'　フリガナが設定されていないなら

　　　　　　.SetPhonetic　'　フリガナ設定（フリガナ第一候補）
　　　　End If
　　End With
End Sub

補足

本格的なコードを書いていただいてありがとうございます。コピペでためさせていただきました。
以下の点を質問させてください。

Sub Re8768439c()
Dim sS As String
Dim sD As String

　　With ActiveCell　'　※　必ず、対象セルをアクティブにしてから実行。

　　　　' ' フリガナを表示する
　　　　If Not .Phonetic.Visible Then .Phonetic.Visible = True

'　　　　' ' フリガナを 同じ行の指定列 にて 参照・表示する
'　　　　With .EntireRow.Cells(1, "C")　'　← "C" ？ 列を要指定
'　　　　　　If .FormulaLocal = "" Then .FormulaLocal = "=PHONETIC(" & ActiveCell.Address & ")"
'　　　　End With

　　　　' ' フリガナが設定されているか、判別
　　　　If .Phonetics.Count > 0 Then　'　フリガナが設定されているなら

　　　　　　' ' 現在設定されているフリガナ を 全角カタカナ で 取得
　　　　　　sS = StrConv(.Phonetic.Text, vbKatakana Or vbWide)

　　　　　　' ' Application.GetPhonetic メソッドで フリガナ第一候補 を取得
　　　　　　' ' セルの値（漢字？相当）を引数に
　　　　　　sD = Application.GetPhonetic(.Value)

　　　　　　' ' 現在のフリガナ と フリガナ候補 が 一致するまで
　　　　　　' ' または フリガナ候補 が 尽きるまで ループ
　　　　　　Do Until sD = sS Or sD = ""
　　　　　　　　sD = Application.GetPhonetic()　'　次のフリガナ候補　を取得
　　　　　　Loop

　　　　　　' ' 次のフリガナ候補　を取得
　　　　　　sD = Application.GetPhonetic() ???

　　　　　　If sD = "" Then　'　フリガナ候補 が 空の文字列 なら
　　　　　　　　.Phonetics.Delete　'　フリガナ設定を削除
　　　　　　Else　'　フリガナ候補 が 空 でなければ
　　　　　　　　.Phonetic.Text = sD　'　フリガナ候補 を フリガナに設定
　　　　　　End If

　　　　Else　'　フリガナが設定されていないなら

　　　　　　.SetPhonetic　'　フリガナ設定（フリガナ第一候補）
　　　　End If
　　End With
End Sub

以下質問

' ' 次のフリガナ候補　を取得
　　　　　　sD = Application.GetPhonetic() ???

???の行はいらないのではないでしょうか。変数を調べたところ、これを実行する前と実行した後で変数の値が違っています。
この行をコメントアウトすると.Phonetic.Text = sDのところでsDの値が目標の値になりますが、実行するとさらに次の候補になってしまうようです。
また
　　Else　'　フリガナ候補 が 空 でなければ
　　　　.Phonetic.Text = sD　'　フリガナ候補 を フリガナに設定
　 End If
を実行するとたしかにsDは目標の新しい振り仮名に設定されていて、.Phonetic.Textの値も新しいものに変わっています。
ところが再度コードを実行すると

' ' Application.GetPhonetic メソッドで フリガナ第一候補 を取得
　　　　　　' ' セルの値（漢字？相当）を引数に
　　　　　　sD = Application.GetPhonetic(.Value)

を実行した後のsDの値が変更する前の元の値にもどってしまっています。そのためsetPhonetic関数の結果も変化しません。
どこに原因があるのか分かりましたらよろしくご教示ください。