Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Select Case Target.Column

    

        Case 7, 11

            

            If Not (ActiveCell.Row > 6) Then Exit Sub

            Call ふりがな設定

    

    End Select

End Sub

Public Sub ふりがな設定()

    Dim Furigana As String

    

    '入力が無ければ何もしない

    If ActiveCell.Offset(, -1).Phonetic.Text = "" Then Exit Sub

    

    '「ふりがな」を平仮名に変換

    Furigana = StrConv(ActiveCell.Offset(, -1).Phonetic.Text, vbHiragana)

    

    '「ふりがな」を15文字分だけ抽出

    ActiveCell.Value = Left(Furigana, 15)

End Sub