Excel - Unicode named cell range - excel

Question

I have written a small function to expedite naming cells:
Public Sub InputSelectedNames()
For Each Cell In Selection
On Error Resume Next
Dim strName As String
strName = InputBox("Enter name for cell " & Cell.Address(False, False) & ":", "Name cell")
If Len(strName) = 0 Then
Exit Sub
End If
ActiveSheet.Names.Add Name:=strName, RefersTo:=Cell
Next Cell
End Sub
This works great until I try to enter a unicode string as a name. If I enter something like "αβγ" it appears as "aß?" in the InputBox.
I've read about VBA using ANSI encoding so I understand why this is the case. The example solution given in that tutorial works for displaying unicode (by passing a pointer instead of a string object), but I wasn't able to utilize the same idea for an InputBox.
If I enter these characters through Excel's 'Define Name' button on the formula tab, or through referencing the character in another cell it works fine, so the mistranslation definitely seems to lay in the InputBox.
My guess is that I'll have to make a Userform to handle the input, unless anyone knows a way to get InputBox to play nicely with unicode?

Answer 1

Creating a custom InputBox did solve this problem.
frmInputBox : UserForm
lblOutput : Label providing prompt
txtInput : TextBox for input
cmdOK : CommandButton for accepting input
cmdCancel : CommandButton for aborting prompt
VBA Form Code:
Private Sub cmdOK_Click()
Accept
End Sub
Private Sub cmdCancel_Click()
Cancel
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel
End Sub
Private Sub txtInput_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
Accept
ElseIf KeyCode = vbKeyEscape Then
Cancel
End If
End Sub
Private Sub Accept()
Me.Hide
End Sub
Private Sub Cancel()
txtInput.Text = ""
Me.Hide
End Sub
Public Function Prompt(strPrompt As String, Optional strTitle As String = "Input", Optional strDefault As String = "")
With Me
.Caption = strTitle
.lblOutput.Caption = strPrompt
.txtInput.Text = strDefault
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
.Show
End With
If txtInput.Text <> "" Then
Prompt = txtInput.Text
Else
Prompt = ""
End If
Unload Me
End Function
Called like:
strMyName = frmInputBox.Prompt("What's your name?", "Name Prompt")