Automating Japanese furigana

[Deadeye]

I found this thread very helpful and was the only decent result that google threw out to me, so sorry for dredging up an old thread.
I found TonyJollans code to be almost correct.

Note I am using English MS Word, Excel 2010 with Japanese Language pack. If you don't have the Language pack it wouldn't work! You need to set the default editing Language to Japanese within the Office 2010 Language Preferences. The main fix I did was GetPhonetic returns Katakana, I couldn't figure out why so I used strConv to convert back to hiragana with the Japan LocaleID.

[vba]
Option Explicit
Option Base 0
Private Const m_sMODULE_NAME As String = "basFixPhonetic"

Public Function g_sFixPhonetic() As String
'########################################################################## ####
' g_sFixPhonetic (PROCEDURE)
' PARAMETERS
'
' RETURN
'
' DESCRIPTION
' Fixes the phonetic Japanese Text to Arial Unicode MS font size 6
' For some reason you must clear any existing furigana otherwise you get
' crazy characters. I think its to do with MSWord saving furgana in this format:
' Kanji(Hiragana)
' So there is a message box asking you if you want to clear existing furigana
' IMPORTANT:
' I use a loop iC1 as I need to modify 450 kanji's so please modify as desired
'########################################################################## ####
' Declare Constants
Const sPROCEDURE_NAME As String = "g_sFixPhonetic"
On Error GoTo ERROR_TRAP

' Declare Variables
Dim iC1 As Integer ' General Counter
Dim xlApp As Excel.Application ' Excel
Dim iClear As Integer ' Clear Furigana

' Initialise
Set xlApp = CreateObject("Excel.Application")

iClear = MsgBox("Click Yes to Clear, No to add Furigana", vbYesNo, "Add Furigana")
' Run for Words
For iC1 = 0 To 450
With Selection

If iClear = vbYes Then
' Clear existing Furigana
.Range.PhoneticGuide Text:=""
.MoveRight Unit:=wdCharacter
Else
Select Case Selection.Range.Kana
Case wdKanaHiragana, wdKanaKatakana
' Do Nothing for now
Case wdUndefined
' GetPhonetic of Kanji via Excel returns Katakana,
' Convert Katakana to Hiragana, use LocaleID 1041 (Japan)
.Range.PhoneticGuide Text:=StrConv(xlApp.GetPhonetic(.Text), vbHiragana, 1041), _
Alignment:=wdPhoneticGuideAlignmentOneTwoOne, _
Raise:=13, FontSize:=5, _
FontName:="Arial Unicode MS"
End Select

.MoveRight Unit:=wdCharacter
End If
End With
Next iC1

CLEAN_UP_EXIT:
On Error GoTo 0
Set xlApp = Nothing
DoEvents
Exit Function

ERROR_TRAP:
If Err.Number <> 0 Then
Call MsgBox(m_sMODULE_NAME & "." & sPROCEDURE_NAME, True, _
Err.Number, Err.Description)

' Call g_ErrorControl(m_sMODULE_NAME & "." & sPROCEDURE_NAME, True, _
Err.Number, Err.Description)
End If
Err.Clear
Resume CLEAN_UP_EXIT
End Function

[/vba]