对于多数人而言,阅读繁体字并不存在困难,但作为日常使用的字体,简体字显然更为直观,一字一句的修改耗时费力,利用程序转换方便快捷。
VBA自定义函数代码如下:
'声明
#If Win64 Then
Private Declare PtrSafe Function LCMapString Lib "kernel32" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
#ElseIf Win32 Then
Private Declare Function LCMapString Lib "kernel32" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
#End If
Function chs2cht(ByVal str As String) As String
'简体转繁体
Dim str_len&, cht$
str_len = lstrlen(str) '指定字符串的长度
cht = Space(str_len) '相同长度的空字符串
LCMapString &H804, &H4000000, str, str_len, cht, str_len
chs2cht = cht
End Function
Function cht2chs(ByVal str As String) As String
'繁体转简体
Dim str_len&, chs$
str_len = lstrlen(str) '指定字符串的长度
chs = Space(str_len) '相同长度的空字符串
LCMapString &H804, &H2000000, str, str_len, chs, str_len
cht2chs = chs
End Function
Sub chs_cht_test()
Debug.Print (cht2chs("我是大陸北方網友,能加個ins詳聊嗎?"))
Debug.Print (chs2cht("我是大陆北方网友,能加个ins详聊吗?"))
'Cells(2, 1) = cht2chs(Cells(1, 1)) '表格使用
End Sub
使用方法:
对A1单元格繁体字进行转换,在A2处输入公式=cht2chs(A1),就得到了转换后的简体字
当下载港台影视作品时,视频名称可能包含繁体字,也可以一键修改:
Sub cht_rename()
'批量重命名文件夹中文件的文件名,繁体转简体
'dir()方法遍历子文件夹文件不太方便,因此最好仅用于单一文件夹下的文件
Dim file_path$, file_name$
'初始化,dir获取文件名
file_path = "D:\学习资料" '待重命名文件所在的文件夹
file_name = Dir(file_path & "\*") '*后可指定文件扩展名
Do While file_name <> ""
olddir = file_path & "\" & file_name
newdir = file_path & "\" & cht2chs(file_name)
Name olddir As newdir
file_name = Dir '下一个文件名
Loop
Debug.Print "该文件夹下所有文件重命名处理完成:" & file_path
End Sub