「フリガナ」の欄に入力 の続き

昨日は、名前の読みが当て字の場合の、「フリガナ」欄の入力方法について検討してみした。
infoment.hatenablog.com

今日は、昨日の続き。

まず起動方法だが、出来るだけ簡単な方が良い。そこで、シートの右クリックイベントに設定してみた。ついでに、「名前」と書かれたセル（A2）の右クリックで、入力欄をリセットしてみよう。

シートモジュール

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Select Case Target(1).Address(0, 0)
        Case "A2"
            Range("B2") = vbNullString
            Cancel = True
        Case "B2"
            NameInputForm.Show
            Cancel = True
    End Select
End Sub

入力済みの場合、或いは一部参照したい場合、入力済みの内容をユーザーフォーム側に転記しておきたい。そこで、ユーザーフォームの初期化時に転記してみる。

ユーザーフォーム（NameInputForm）

Dim NameRange As Range
Dim FuriganaRange As Range

Private Sub UserForm_Initialize()
    Set NameRange = Range("B2")
    Set FuriganaRange = Range("B1")
    
        ' 入力済み内容をフォームに転記することで、
        ' 入力の一助とする。
        If NameRange <> vbNullString Then
            NameTextBox = NameRange
            FuriganaTextBox = FuriganaRange
        End If
End Sub

残りは昨日と同じだが、念のため再掲。上記同様、ユーザーフォームに記載する。

Private Sub InputCommandButton_Click()
    If CheckBlank Then
        NameRange = NameTextBox ' 氏名入力用テキストボックス
        AddPhonetic NameRange, _
                    FuriganaTextBox ' フリガナ入力用テキストボックス
        Unload Me
    End If
End Sub
Sub AddPhonetic(target_range As Range, kana_to_add As String)
    target_range.Characters.PhoneticCharacters = kana_to_add
End Sub
Private Property Get CheckBlank() As Boolean
    Dim Control As Msforms.Control
        For Each Control In Me.Controls
            If TypeName(Control) = "TextBox" Then
                If Control.Object.Value = vbNullString Then
                    CheckBlank = False
                    Exit Property
                End If
            End If
        Next
        CheckBlank = True
End Property

後は、氏名とフリガナのテキストボックスを取り違えないよう、フリガナ側のテキストボックスのIME MODEをカタカナにしておくと良いかも。

でも、ここまで作りこんで見せてみても、帳票の所管部門には採用されないんだろうな、きっと。

参考まで。