web-dev-qa-db-ja.com

現在のユーザー言語を探す

vba プログラムで現在のユーザー言語を知るにはどうすればよいですか？

適切な言語でフォームを表示するには、これが必要です。

excelvbaexcel-vbaexcel-2010
16
BetaRide

私の最初のコード（これを利用する vbforum code ）は、WindowsとExcelが共通の言語を共有していることを前提としていました。

更新

改訂されたコード：

  1. ロケールID（LCID）を返します。
  2. これからLCIDを検索します msft link 。
  3. regexp を使用してLCIDを解析し、言語を取得します。

以下の私のマシンでのサンプル出力

このコードは、LCID Webサイトへのアクセス、または国名の解析でエラーが発生したかどうかをユーザーに通知します。

enter image description here

    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
16
brettdj
dim lang_code as long
lang_code = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
11
GSerg

これは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
1
YasserKhalil
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

0
Shankar ARUL - jupyterdata.com