一、引言
每年的高考、会考、中考、注册会计师等职称考试和计算机水平考试前夕，在填写报名信息卡时，所涂写姓名的信息代码就是姓名汉字对应的区位码，要查询汉字
区位码，还是离不开一本小册子——《汉字区位码手册》或《报考指南》。这样很不方便，并且费时费力，甚至还易查错，尤其对于学校以班集体为单体报名的就显得更不方便了。笔者通过实践探索，用VisualBasic编程可以方便地实现姓名区位码的自动转换。并且编制了考生姓名区位码自动查询工具，方便实用，现在奉献给大家。
二、转换原理
西文使用的编码通常是ASCII码，一个汉字有ASCⅡ码、区位码等与之对应。ASCⅡ码中对应于码值161到254 的字符用于表示汉字，每个汉字用两个ASCⅡ码值对应的字符表示。GB2312-80就是中文的标准编码，即国标码。
区位码是与汉字一一对应的编码，用四位数字表示， 前两位从01 到94称区码，后两位从01到94称位码。 一个汉字的前一半是 ASCⅡ码为“160＋区码”的字符，后一半是ASCⅡ码为“160＋ 位码”的字符。即是把组成汉字的两个ASCII码各减去160，所得结果组合起来就是区位码。如“国”字，ASCII码减去160后，两部分分别为：25、90，则“国”字的区位码为2590。
三、实现功能
1、 实现单个姓名的区位码查询。
2、 实现区位码对应的汉字查询。
3、 实现批量姓名的区位码查询。
4、 能自动导入姓名到EXCEL表。
5、 能打印姓名对照的区位码表。
四、编制程序
根据上面要求实现的功能，我们按照以下步骤进行程序编制。
1、 在VB环境中新建窗体FORM1，在FORM1中添加控件，如下左图。在EXCELk 新建一个表aaa2.xls,如下右图。

① 添加8个CommandButton，他们的Caption分别为“初始化”、“导入数据”、“打开EXCEL输入姓名”、“求EXCEL表中姓名区位码”、“计算单个姓名区位码”、“区位码转换为汉字”、“打印姓名区位码对照表”和“使用帮助”。
② 添加三个TextBox,其中Text2，Text3要求分别复制四个，形成textbox数组，用来显示姓名和姓名对应的区位码。
③ 添加DirvelistBox,DirlistBox,FilelistButton三个控件，用来选择驱动器、文件夹、文件进行数据导入。
④ 为了进行批量姓名的区位码查询，我们这里没用数据库来处理，而是用EXECL表来处理显得更加方便，具体作法在程序中说明。
2、 在Form1和CommandButton中加入程序代码。
① 在Form1中加入以下代码。（用来建立EXECEL表对象）
Dim xlsApp As Excel.Application
Dim xlsWB As Excel.Workbook
Dim xlsWS As Excel.Worksheet
Dim xlswd As Excel.Workbook
Dim xlswf As Excel.Worksheet
Dim jsbstr As String
② 在“初始化”中加入以下代码。（用来清空aaa2.xls中的数据）
Private Sub Command4_Click()
Set xlsApp = Excel.Application
Set xlsWB = xlsApp.Workbooks.Open(App.Path + "\aaa2.xls")
Set xlsWS = xlsWB.Worksheets(1)
For ii = 4 To 1000
xlsWS.Range("a" + Trim(Str(ii))) = ""
xlsWS.Range("b" + Trim(Str(ii))) = ""
xlsWS.Range("c" + Trim(Str(ii))) = ""
xlsWS.Range("d" + Trim(Str(ii))) = ""
xlsWS.Range("e" + Trim(Str(ii))) = ""
Next ii
MsgBox ("初始化已完成！")
xlsWB.Close
End Sub
③ 在“导入数据”、“打开EXCEL输入姓名”中加入代码。（由于篇幅省略）。
④ 在“求EXCEL表中姓名区位码”中加入代码如下
Private Sub Command2_Click()
Dim ii As Integer
Dim f
Set xlsApp = Excel.Application
Set xlsWB = xlsApp.Workbooks.Open(App.Path + "\aaa2.xls")
Set xlsWS = xlsWB.Worksheets(1)
ii = 4
For ii = 4 To 1000
If Trim.lsWS.Range("a" + Trim(Str(ii)))) <> "" Then
Dim L1. R1 As Integer
Dim l2, r2 As String
InputStr = Trim(xlsWS.Range("a" + Trim(Str(ii))))
Dim ik As Integer, res As String
res = InputStr
Search = " "
Do While InStr(res, Search)
ik = InStr(res, Search)
res = Left(res, ik - 1) & Mid(res, ik + 1)
Loop
InputStr = res
If Len(InputStr) = 0 Then
Text2.ForeColor = &HFF&
Text2.Text = "没有要查的汉字"
Else, If Len(InputStr) > 4 Then
Text2.Text = "汉字太多"
Else
For i = 1 To Int(Len(InputStr))
jsbstr = Trim(Mid(InputStr, i, 1))
If jsbstr <> "" Then
f = Hex(Asc(jsbstr))
Text3(i - 1).Text = Mid(InputStr, i, 1)
L1 = CInt("&H" + Mid(f, 1, 2)) - 160
R1 = CInt("&H" + Mid(f, 3, 2)) - 160
If Len(L1) = 1 Then
l2 = "0" + Str(Trim(R1))
Else
l2 = Trim(Str(Trim(L1)))
End If
If Len(Trim(Str(R1))) = 1 Then
r2 = "0" + Trim(Str(R1))
Else
r2 = Trim(Str(Trim(R1)))
End If
Text1(i - 1).Text = l2 + Trim(r2)
Else
Text1(i - 1).Text = ""
End If
Next i
xlsWS.Range("b" + Trim(Str(ii))) = Text1(0).Text
xlsWS.Range("c" + Trim(Str(ii))) = Text1(1).Text
xlsWS.Range("d" + Trim(Str(ii))) = Text1(2).Text
xlsWS.Range("e" + Trim(Str(ii))) = Text1(3).Text
If i = 2 Then
xlsWS.Range("c" + Trim(Str(ii))) = ""
xlsWS.Range("d" + Trim(Str(ii))) = ""
xlsWS.Range("e" + Trim(Str(ii))) = ""
End If
If i = 3 Then
xlsWS.Range("d" + Trim(Str(ii))) = ""
xlsWS.Range("e" + Trim(Str(ii))) = ""
End If
If i = 4 Then
xlsWS.Range("e" + Trim(Str(ii))) = ""
End If
End If
End If
End If
Next ii
MsgBox ("计算已完成！")
xlsWB.Close
End Sub
⑤ 在“计算单个姓名区位码”、“使用帮助”中加入代码。（由于篇幅略）。
⑥ 在“区位码转换为汉字”加入以下代码。
Private Sub Command8_Click()
Dim bArr(1) As Byte
Dim sMe As String
bArr(0) = Val(Mid$(Text2.Text, 1, 2)) + 160
bArr(1) = Val(Mid$(Text2.Text, 3, 2)) + 160
sMe = StrConv(bArr, vbUnicode)
Text3(0).Text = Text2.Text
Text1(0).Text = sMe
End Sub
⑦ 在“打印姓名区位码表”中加入以下代码
Private Sub Command5_Click()
Set xlsApp = Excel.Application
Set xlsWB = xlsApp.Workbooks.Open(App.Path + "\aaa2.xls")
Set xlsWS = xlsWB.Worksheets(1)
xlsWS.PrintOut
End Sub
（说明：以上程序在VB6.0上运行通过）