vba 查找当前用户语言
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8588728/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Find the current user language
提问by BetaRide
采纳答案by brettdj
My initial code (utilising this vbforum code) assumed that Windows and Excel share a common language - likely but not bulletproof.
我的初始代码（使用此vbforum 代码）假定 Windows 和 Excel 共享一种通用语言 - 可能但不是防弹的。
updated
更新
The revised code:
修改后的代码：
- Returns the Locale ID (LCID).
- Looks up the LCID from this msft link.
- Parses the LCID using a regexpto get the language.
Sample output on my machine below
下面我的机器上的示例输出
The code will let the user know if there are any errors in accessing the LCID website, or in parsing the country name.
该代码将让用户知道在访问 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
回答by GSerg
dim lang_code as long
lang_code = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
回答by YasserKhalil
This is another variation of the code posted by brettdj
这是 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
回答by Shankar ARUL - jupyterdata.com
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
Straight out of here: https://bettersolutions.com/vba/macros/region-language.htm
直接离开这里：https: //bettersolutions.com/vba/macros/region-language.htm
Relevant Documentation: https://docs.microsoft.com/en-us/office/vba/api/excel.xlapplicationinternational
相关文档：https: //docs.microsoft.com/en-us/office/vba/api/excel.xlapplicationinternational
