如何用vba枚举系统中所有已安装或者支持的LCID？

EnumSystemLocalesEx函数可以枚举所有已安装或者系统支持的区域。

它的语法如下：

BOOL EnumSystemLocalesEx(
  LOCALE_ENUMPROCEX lpLocaleEnumProcEx,
  DWORD             dwFlags,
  LPARAM            lParam,
  LPVOID            lpReserved
);

其中lpLocaleEnumProcEx参数为指向回调函数EnumLocalesProcEx的指针。

回调函数EnumLocalesProcEx的语法如下：

BOOL CALLBACK EnumLocalesProcEx(
  _In_ LPWSTR lpLocaleString,
  _In_ DWORD  dwFlags,
  _In_ LPARAM lParam
);

其中参数lpLocaleString 为指向区域名称的缓冲区的指针。

将它们转换为vba 声明如下：

Declare Function EnumSystemLocalesEx Lib "kernel32" (ByVal lpLocaleEnumProcEx As Long, ByVal dwFlags As Long, ByVal lParam As Long, ByVal lpReserved As Long) As Long

Function EnumLocalesProcEx(ByVal lpLocaleString As Long, ByVal dwFlags As Long, ByVal lParam As Long) As Long
    EnumLocalesProcEx = 1
End Function

两个需要特别注意的是：回调函数的返回值必须为1，才能遍历枚举，另外在vba声明中lpLocaleString参数必须为long类型，存储的是地址，否则也无法返回正确值。

综合以上知识，可以使用如下的代码：

Declare Function LCIDToLocaleName Lib "kernel32" (ByVal Locale As Long, ByVal lpName As String, ByVal cchName As Long, ByVal dwFlags As Long) As Long
Declare Function LocaleNameToLCID Lib "kernel32" (ByVal lpName As Long, ByVal dwFlags As Long) As Long
Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Declare Function EnumSystemLocalesEx Lib "kernel32" (ByVal lpLocaleEnumProcEx As Long, ByVal dwFlags As Long, ByVal lParam As Long, ByVal lpReserved As Long) As Long
Const LOCALE_NAME_MAX_LENGTH = 85
Const LCID_INSTALLED = 1
Const LCID_SUPPORTED = 2
Const LCID_ALTERNATE_SORTS = 4
Sub QQ1722187970()
    Dim oWK As Worksheet
    Set oWK = Excel.ActiveSheet
    oWK.Cells.Clear
    EnumSystemLocalesEx AddressOf EnumLocalesProcEx, 0, 0, 0
End Sub
Function EnumLocalesProcEx(ByVal lpLocaleString As Long, ByVal dwFlags As Long, ByVal lParam As Long) As Long
    iLCID = LocaleNameToLCID(lpLocaleString, 0)
    Dim sLocaleName As String
    'LCID2LocaleName
    sLocaleName = Space(LOCALE_NAME_MAX_LENGTH)
    iLen = LCIDToLocaleName(iLCID, sLocaleName, LOCALE_NAME_MAX_LENGTH, 0) - 1
    sLocaleName = VBA.Replace(sLocaleName, Chr(0), "")
    sLocaleName = Left(sLocaleName, iLen)
    Dim oWK As Worksheet
    Set oWK = Excel.ActiveSheet
    oWK.Range("a1:c1") = Array("LCID(16进制)", "LCID(10进制)", "LocaleName")
    iRow = oWK.Range("a65536").End(xlUp).Row + 1
    With oWK
        .Cells(iRow, "A") = VBA.Hex(iLCID)
        .Cells(iRow, "B") = iLCID
        .Cells(iRow, "C") = sLocaleName
    End With
    EnumLocalesProcEx = 1
End Function

下表是枚举后的结果：