如何在vba程序中说出当前的用户语言?
我需要这个以适当的语言显示一个表单。
我的初始代码(利用这个vbforum code)假设Windows和Excel共享一种共同语言 - 可能但不是防弹。
更新
修订后的代码:
我的机器下面的示例输出
代码将让用户知道访问LCID网站或解析国家/地区名称时是否有任何错误。
Sub GetXlLang()
Dim lngCode As Long
lngCode = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
MsgBox "Code is: " & lngCode & vbNewLine & GetTxt(lngCode)
End Sub
Function GetTxt(ByVal lngCode) As String
Dim objXmlHTTP As Object
Dim objRegex As Object
Dim objRegMC As Object
Dim strResponse As String
Dim strSite As String
Set objXmlHTTP = CreateObject("MSXML2.XMLHTTP")
strSite = "http://msdn.microsoft.com/en-us/goglobal/bb964664"
On Error GoTo ErrHandler
With objXmlHTTP
.Open "GET", strSite, False
.Send
If .Status = 200 Then strResponse = .ResponseText
End With
On Error GoTo 0
strResponse = Replace(strResponse, "</td><td>", vbNullString)
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "><td>([a-zA-Z- ]+)[A-Fa-f0-9]{4}" & lngCode
If .Test(strResponse) Then
Set objRegMC = .Execute(strResponse)
GetTxt = objRegMC(0).submatches(0)
Else
GetTxt = "Value not found from " & strSite
End If
End With
Set objRegex = Nothing
Set objXmlHTTP = Nothing
Exit Function
ErrHandler:
If Not objXmlHTTP Is Nothing Then Set objXmlHTTP = Nothing
GetTxt = strSite & " unable to be accessed"
End Function
dim lang_code as long
lang_code = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
Select Case Application.International(xlApplicationInternational.xlCountryCode)
Case 1: Call MsgBox("English")
Case 33: Call MsgBox("French")
Case 49: Call MsgBox("German")
Case 81: Call MsgBox("Japanese")
End Select
直接离开这里:https://bettersolutions.com/vba/macros/region-language.htm
相关文档:https://docs.microsoft.com/en-us/office/vba/api/excel.xlapplicationinternational
这是brettdj发布的代码的另一种变体
Sub Test_GetLocale_UDF()
Dim lngCode As Long
lngCode = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
MsgBox "Code Is: " & lngCode & vbNewLine & GetLocale(lngCode)
End Sub
Function GetLocale(ByVal lngCode) As String
Dim html As Object
Dim http As Object
Dim htmlTable As Object
Dim htmlRow As Object
Dim htmlCell As Object
Dim url As String
Set html = CreateObject("htmlfile")
Set http = CreateObject("MSXML2.XMLHTTP")
url = "https://www.science.co.il/language/Locale-codes.php"
On Error GoTo ErrHandler
With http
.Open "GET", url, False
.send
If .Status = 200 Then html.body.innerHTML = .responseText
End With
On Error GoTo 0
Set htmlTable = html.getElementsByTagName("table")(0)
For Each htmlRow In htmlTable.getElementsByTagName("tr")
For Each htmlCell In htmlRow.Children
If htmlCell.innerText = CStr(lngCode) Then
GetLocale = htmlRow.getElementsByTagName("td")(0).innerText
Exit For
End If
Next htmlCell
Next htmlRow
If GetLocale = "" Then GetLocale = "Value Not Found From " & url
Exit Function
ErrHandler:
If Not http Is Nothing Then Set http = Nothing
GetLocale = url & " Unable To Be Accessed"
End Function