| 投稿日 | ： 2002/08/20(Tue) 10:55 |
| 投稿者 | ： 花ちゃん |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： （関連質問）エクセルを利用して(空白対策）フリガナを取得について |
上記の設定でふりがなを取得する場合、文字の間に空白が１個入ると下記のように
うまく変換されません。
花房春男 ＝ はなふさはるお
花房 春男 ＝ はなふさ
花房 春男 ＝ はなぶさ はるお (半角２個の空白）
花 房 春 男 ＝ はな ふさ はる おとこ (半角１個の空白）
それで下記のようなコードを作成したのですが！
結構コードが長くなったし、他にいいアイデアがないか、お知恵を拝借したいと思い投稿しました。
Private Sub Text1_LostFocus()
Dim MyName1 As String
Dim MyName2 As String
Dim MyName3 As String
Dim MyName4 As String
Dim i As Long
MyName1 = Text1.Text
MyName1 = Replace(MyName1, " ", ":")
MyName1 = Replace(MyName1, " ", "：")
MyName2 = Replace(MyName1, ":", "")
MyName2 = Replace(MyName2, "：", "")
If Text1.Text <> "" Then
MyName3 = CreateObject("Excel.Application").GetPhonetic(MyName2)
MyName4 = CreateObject("Excel.Application").GetPhonetic(MyName1)
MyName3 = StrConv(MyName3, vbHiragana)
MyName4 = StrConv(MyName4, vbHiragana)
For i = 1 To Len(MyName4)
If Mid$(MyName4, i, 1) = ":" Then
MyName3 = Left$(MyName3, i - 1) & " " & _
Right$(MyName3, Len(MyName3) - i + 1)
End If
If Mid$(MyName4, i, 1) = "：" Then
MyName3 = Left$(MyName3, i - 1) & " " & _
Right$(MyName3, Len(MyName3) - i + 1)
End If
Next i
Text2.Text = MyName3
Else
Text2.Text = ""
End If
End Sub