Znajdź bieżący język użytkownika

Question

Jak mogę sprawdzić bieżący język użytkownika w programie vba?

Potrzebuję tego, aby pokazać formularz w odpowiednim języku.

Answer 1

Mój początkowy kod (wykorzystując tę ​​vbforum code) Zakłada się, że system Windows i Excel dzielą wspólny język - prawdopodobny, ale nie kuloodporną.

aktualizowane

Zmieniony kod:

1. Zwraca identyfikator ustawień regionalnych (LCID).
2. Wyszukuje identyfikator LCID z tego msft link.
3. Analizuje identyfikator LCID za pomocą regexp, aby uzyskać język.

Przykładowe wyjście na moim komputerze poniżej

kodu pozwoli użytkownikowi wiedzieć, czy są jakieś błędy w dostępie do strony internetowej LCID lub w parsowania nazwę kraju.

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 

Answer 2

dim lang_code as long 
lang_code = Application.LanguageSettings.LanguageID(msoLanguageIDUI)