英文:
How can I provide Nothing (Null-Pointer) to a user defined type in VBA for using it as Windows API function argument?
问题
VBA中，我声明了一个需要指向struct参数的Windows API函数。为了表示这个struct，我创建了一个Public Type，并将函数参数声明为ByRef。
现在，这个struct指针可能为null，所以我尝试将Nothing赋值给我的UDT变量，但这并不起作用。
我该如何使这个工作？
以下是我代码的基本摘录：
Private Declare PtrSafe Function GetNumberFormatEx& Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags&, _
ByVal lpValue As LongPtr, _
ByRef lpFormat As NumberFormat, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber& _
)
Public Type NumberFormat
NumDigits As Integer
LeadingZero As Integer
Grouping As Integer
lpDecimalSep As LongPtr
lpThousandSep As LongPtr
NegativeOrder As Integer
End Type
Public Function FormatNumberLocale$(srcValue As Double, lcid$, Optional flags& = 0, Optional customFormat$ = vbNullString)
Dim buffer$
Dim charCount&
Dim numFormat As NumberFormat
buffer = String(100, 0)
'numFormat = Nothing ' THIS DOESN'T WORK !!!
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(Str$(srcValue)), numFormat, StrPtr(buffer), 100)
If charCount > 0 Then FormatNumberLocale = Left$(buffer, charCount)
End Function
编辑
我将声明更改为：
Private Declare PtrSafe Function GetNumberFormatEx& Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags&, _
ByVal lpValue As LongPtr, _
ByVal lpFormat As LongPtr, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber& _
)
并像这样调用函数：
...
Dim value$
buffer = String(100, 0)
value = Str$(srcValue)
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(value), CLngPtr(0&), StrPtr(buffer), 100)
但即使使用基本参数调用它，例如?FormatNumberLocale(123,"en")，charCount始终为0，Err.LastDllError始终返回87 (0x57): ERROR_INVALID_PARAMETER。
有什么建议吗？
英文:
In VBA, I declared a Windows API function that requires a pointer to a struct argument. For representing this struct I created a Public Type and declared the function parameter as ByRef.
Now, this struct pointer may be null, so I tried to assign Nothing to a variable of my UDT, but that doesn't work.
How can I make this work?
Here are the basic excerpts from my code:
Private Declare PtrSafe Function GetNumberFormatEx& Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags&, _
ByVal lpValue As LongPtr, _
ByRef lpFormat As NumberFormat, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber& _
)
Public Type NumberFormat
NumDigits As Integer
LeadingZero As Integer
Grouping As Integer
lpDecimalSep As LongPtr
lpThousandSep As LongPtr
NegativeOrder As Integer
End Type
Public Function FormatNumberLocale$(srcValue As Double, lcid$, Optional flags& = 0, Optional customFormat$ = vbNullString)
Dim buffer$
Dim charCount&
Dim numFormat As NumberFormat
buffer = String(100, 0)
'numFormat = Nothing ' THIS DOESN'T WORK !!!
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(Str$(srcValue)), numFormat, StrPtr(buffer), 100)
If charCount > 0 Then FormatNumberLocale = Left$(buffer, charCount)
End Function
Edit
I changed the declaration to:
Private Declare PtrSafe Function GetNumberFormatEx& Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags&, _
ByVal lpValue As LongPtr, _
ByVal lpFormat As LongPtr, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber& _
)
and called the function like this:
...
Dim value$
buffer = String(100, 0)
value = Str$(srcValue)
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(value), CLngPtr(0&), StrPtr(buffer), 100)
But even when calling it with basic parameters, like ?FormatNumberLocale(123,"en"), charCount is always 0, and Err.LastDllError always returns 87 (0x57): ERROR_INVALID_PARAMETER.
Any ideas?
答案1
得分: 2
VBA中传递NULL给结构指针的习惯做法是将参数声明为ByRef As Any：
Private Declare PtrSafe Function GetNumberFormatEx Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags As Long, _
ByVal lpValue As LongPtr, _
ByRef lpFormat As Any, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber As Long _
) As Long
然后传递要么是一个结构变量（在你的示例中是numFormat），要么是ByVal 0&以表示空指针。
英文:
The idiomatic VBA way of passing NULL for a struct pointer is declaring the argument as ByRef As Any:
Private Declare PtrSafe Function GetNumberFormatEx Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags As Long, _
ByVal lpValue As LongPtr, _
ByRef lpFormat As Any, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber As Long _
) As Long
and then passing either a struct variable (numFormat in your example) or ByVal 0& for null.
答案2
得分: -1
'@References
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getnumberformatex
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getsystemdefaultlocalename
Option Explicit
'@Reference
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/ns-winnls-numberfmta
Public Type NumberFormat
NumDigits As Long 'Number of fractional digits placed after the decimal separator.
LeadingZero As Long '0 No leading zeros, 1 Leading zeros
Grouping As Long 'Values in the range 0 through 9 and 32 are valid
'Typical examples of settings for this member are: 0 to group digits as in 123456789.00;
'3 to group digits as in 123,456,789.00; and 32 to group digits as in 12,34,56,789.00.
lpDecimalSep As LongPtr 'Pointer to a null-terminated decimal separator string.
lpThousandSep As LongPtr 'Pointer to a null-terminated thousand separator string.
NegativeOrder As Long 'Negative number mode. This mode is equivalent to the locale information specified by the value
'https://learn.microsoft.com/en-us/windows/win32/intl/locale-ineg-constants
End Type
Private Const LOCALE_NOUSEROVERRIDE As Long = &H80000000
Private Const NULL_PTR As LongPtr = 0
' https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
' https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--1000-1299-
Private Const ERROR_OUTOFMEMORY As Long = 14 '(0xE)
Private Const ERROR_INVALID_PARAMETER As Long = 87 '(0x57)
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122 '(0x7A)
Private Const ERROR_INVALID_FLAGS As Long = 1004 '(0x3EC)
Private Declare PtrSafe Function GetSystemDefaultLocaleName Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal cchLocaleName As Long _
) As Long
Private Declare PtrSafe Function GetNumberFormatEx Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags As Long, _
ByVal lpValue As LongPtr, _
ByVal lpFormat As LongPtr, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber As Long _
) As Long
'@Exceptions
' ERROR_INSUFFICIENT_BUFFER. A supplied buffer size was not large enough, or it was incorrectly set to NULL.
Public Function GetSystemLocalName() As String
Const LOCALE_NAME_MAX_LENGTH As Long = 85
Const CHAR_LENGTH As Long = 2
Dim buffer() As Byte
ReDim buffer(LOCALE_NAME_MAX_LENGTH * CHAR_LENGTH)
Dim bufferPtr As LongPtr
bufferPtr = VarPtr(buffer(0))
Dim charCount As Long
charCount = GetSystemDefaultLocaleName(bufferPtr, LOCALE_NAME_MAX_LENGTH)
If charCount > 0 Then
ReDim Preserve buffer((charCount - 1) * CHAR_LENGTH)
GetSystemLocalName = buffer
Else
Select Case Err.LastDllError
Case ERROR_INSUFFICIENT_BUFFER
Err.Raise Err.LastDllError, "GetSystemLocalName", "A supplied buffer size was not large enough, or it was incorrectly set to NULL."
Case Else
Err.Raise Err.LastDllError, "GetSystemLocalName", "Unexpected error occurred."
End Select
End If
End Function
'@Exceptions
' ERROR_INSUFFICIENT_BUFFER. A supplied buffer size was not large enough, or it was incorrectly set to NULL.
' ERROR_INVALID_FLAGS. The values supplied for flags were not valid.
' ERROR_INVALID_PARAMETER. Any of the parameter values was invalid.
' ERROR_OUTOFMEMORY. Not enough storage was available to complete this operation.
Public Function FormatNumberLocale(ByVal value As Double, ByVal lcid As String, Optional ByVal flags As Long = 0) As String
Const MAX_BUFFER_LENGTH As Long = 100
Const CHAR_LENGTH As Long = 2
Dim buffer() As Byte
ReDim buffer(MAX_BUFFER_LENGTH * CHAR_LENGTH)
Dim bufferPtr As LongPtr
bufferPtr = VarPtr(buffer(0))
Dim charCount As Long
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(CStr(value)), NULL_PTR, bufferPtr, MAX_BUFFER_LENGTH)
If charCount > 0 Then
ReDim Preserve buffer((charCount - 1) * CHAR_LENGTH)
FormatNumberLocale = buffer
Else
Select Case Err.LastDllError
Case ERROR_INSUFFICIENT_BUFFER
Err.Raise Err.LastDllError, "FormatNumberLocale", "A supplied buffer size was not large enough, or it was incorrectly set to NULL."
Case ERROR_INVALID_FLAGS
Err.Raise Err.LastDllError, "FormatNumberLocale", "The values supplied for flags were not valid."
Case ERROR_INVALID_PARAMETER
Err.Raise Err.LastDllError, "FormatNumberLocale", "Any of the parameter values was invalid."
Case ERROR_OUTOFMEMORY
Err.Raise Err.LastDllError, "FormatNumberLocale", "Not enough storage was available to complete this operation."
Case Else
Err.Raise Err.LastDllError, "FormatNumberLocale", "Unexpected error occurred."
End Select
End If
End Function
Public Sub FormatNumberLocaleTest()
Dim value As Double
Dim lcid As String
Dim valueLocal As String
value = 12345.678
lcid = GetSystemLocalName()
valueLocal = FormatNumberLocale(value, lcid, LOCALE_NOUSEROVERRIDE)
Debug.Print " Value: " & value
Debug.Print " Format value local: " & valueLocal
Debug.Print " System Local Name: " & lcid
Debug.Print
lcid = "de-DE"
valueLocal = FormatNumberLocale(value, lcid)
Debug.Print " Value: " & value
Debug.Print " Format value local: " & valueLocal
Debug.Print " System Local Name: " & lcid
Debug.Print
End Sub
'@Output:
' Value: 12345.67
' Format value local: 12,345.67
' System Local Name: en-AU
'
' Value: 12345.67
' Format value local: 12.345,67
' System Local Name: de-DE
'Notes UDT types are not allowed to optional and must be passed by reference
'Possible work around wrap the UDT in an object and check if missing use NULL_PTR or VarPtr of UDT of type NumberFormat
Public Function FormatNumberCustom(ByVal value As Double, ByVal lcid As String, ByVal flags As Long, ByRef customFormat As NumberFormat) As String
Const MAX_BUFFER_LENGTH As Long = 100
Const CHAR_LENGTH As Long =
<details>
<summary>英文:</summary>
'@References
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getnumberformatex
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getsystemdefaultlocalename
Option Explicit
'@Reference
' https://learn.microsoft.com/en-us/windows/win32/api/winnls/ns-winnls-numberfmta
Public Type NumberFormat
NumDigits As Long 'Number of fractional digits placed after the decimal separator.
LeadingZero As Long '0 No leading zeros, 1 Leading zeros
Grouping As Long 'Values in the range 0 through 9 and 32 are valid
'Typical examples of settings for this member are: 0 to group digits as in 123456789.00;
'3 to group digits as in 123,456,789.00; and 32 to group digits as in 12,34,56,789.00.
lpDecimalSep As LongPtr 'Pointer to a null-terminated decimal separator string.
lpThousandSep As LongPtr 'Pointer to a null-terminated thousand separator string.
NegativeOrder As Long 'Negative number mode. This mode is equivalent to the locale information specified by the value
'https://learn.microsoft.com/en-us/windows/win32/intl/locale-ineg-constants
End Type
Private Const LOCALE_NOUSEROVERRIDE As Long = &H80000000
Private Const NULL_PTR As LongPtr = 0
' https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
' https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--1000-1299-
Private Const ERROR_OUTOFMEMORY As Long = 14 '(0xE)
Private Const ERROR_INVALID_PARAMETER As Long = 87 '(0x57)
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122 '(0x7A)
Private Const ERROR_INVALID_FLAGS As Long = 1004 '(0x3EC)
Private Declare PtrSafe Function GetSystemDefaultLocaleName Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal cchLocaleName As Long _
) As Long
Private Declare PtrSafe Function GetNumberFormatEx Lib "Kernel32" ( _
ByVal lpLocaleName As LongPtr, _
ByVal dwFlags As Long, _
ByVal lpValue As LongPtr, _
ByVal lpFormat As LongPtr, _
ByVal lpNumberStr As LongPtr, _
ByVal cchNumber As Long _
) As Long
'@Exceptions
' ERROR_INSUFFICIENT_BUFFER. A supplied buffer size was not large enough, or it was incorrectly set to NULL.
Public Function GetSystemLocalName() As String
Const LOCALE_NAME_MAX_LENGTH As Long = 85
Const CHAR_LENGTH As Long = 2
Dim buffer() As Byte
ReDim buffer(LOCALE_NAME_MAX_LENGTH * CHAR_LENGTH)
Dim bufferPtr As LongPtr
bufferPtr = VarPtr(buffer(0))
Dim charCount As Long
charCount = GetSystemDefaultLocaleName(bufferPtr, LOCALE_NAME_MAX_LENGTH)
If charCount > 0 Then
ReDim Preserve buffer((charCount - 1) * CHAR_LENGTH)
GetSystemLocalName = buffer
Else
Select Case Err.LastDllError
Case ERROR_INSUFFICIENT_BUFFER
Err.Raise Err.LastDllError, "GetSystemLocalName", "A supplied buffer size was not large enough, or it was incorrectly set to NULL."
Case Else
Err.Raise Err.LastDllError, "GetSystemLocalName", "Unexpected error occurred."
End Select
End If
End Function
'@Exceptions
' ERROR_INSUFFICIENT_BUFFER. A supplied buffer size was not large enough, or it was incorrectly set to NULL.
' ERROR_INVALID_FLAGS. The values supplied for flags were not valid.
' ERROR_INVALID_PARAMETER. Any of the parameter values was invalid.
' ERROR_OUTOFMEMORY. Not enough storage was available to complete this operation.
Public Function FormatNumberLocale(ByVal value As Double, ByVal lcid As String, Optional ByVal flags As Long = 0) As String
Const MAX_BUFFER_LENGTH As Long = 100
Const CHAR_LENGTH As Long = 2
Dim buffer() As Byte
ReDim buffer(MAX_BUFFER_LENGTH * CHAR_LENGTH)
Dim bufferPtr As LongPtr
bufferPtr = VarPtr(buffer(0))
Dim charCount As Long
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(CStr(value)), NULL_PTR, bufferPtr, MAX_BUFFER_LENGTH)
If charCount > 0 Then
ReDim Preserve buffer((charCount - 1) * CHAR_LENGTH)
FormatNumberLocale = buffer
Else
Select Case Err.LastDllError
Case ERROR_INSUFFICIENT_BUFFER
Err.Raise Err.LastDllError, "FormatNumberLocale", "A supplied buffer size was not large enough, or it was incorrectly set to NULL."
Case ERROR_INVALID_FLAGS
Err.Raise Err.LastDllError, "FormatNumberLocale", "The values supplied for flags were not valid."
Case ERROR_INVALID_PARAMETER
Err.Raise Err.LastDllError, "FormatNumberLocale", "Any of the parameter values was invalid."
Case ERROR_OUTOFMEMORY
Err.Raise Err.LastDllError, "FormatNumberLocale", "Not enough storage was available to complete this operation."
Case Else
Err.Raise Err.LastDllError, "FormatNumberLocale", "Unexpected error occurred."
End Select
End If
End Function
Public Sub FormatNumberLocaleTest()
Dim value As Double
Dim lcid As String
Dim valueLocal As String
value = 12345.678
lcid = GetSystemLocalName()
valueLocal = FormatNumberLocale(value, lcid, LOCALE_NOUSEROVERRIDE)
Debug.Print " Value: " & value
Debug.Print " Format value local: " & valueLocal
Debug.Print " System Local Name: " & lcid
Debug.Print
lcid = "de-DE"
valueLocal = FormatNumberLocale(value, lcid)
Debug.Print " Value: " & value
Debug.Print " Format value local: " & valueLocal
Debug.Print " System Local Name: " & lcid
Debug.Print
End Sub
'Output:
' Value: 12345.67
' Format value local: 12,345.67
' System Local Name: en-AU
'
' Value: 12345.67
' Format value local: 12.345,67
' System Local Name: de-DE
'Notes UDT types are not allowed to optional and must be passed by reference
'Possible work around wrap the UDT in an object and check if missing use NULL_PTR or VarPtr of UDT of type NumberFormat
Public Function FormatNumberCustom(ByVal value As Double, ByVal lcid As String, ByVal flags As Long, ByRef customFormat As NumberFormat) As String
Const MAX_BUFFER_LENGTH As Long = 100
Const CHAR_LENGTH As Long = 2
Dim buffer() As Byte
ReDim buffer(MAX_BUFFER_LENGTH * CHAR_LENGTH)
Dim bufferPtr As LongPtr
bufferPtr = VarPtr(buffer(0))
Dim charCount As Long
charCount = GetNumberFormatEx(StrPtr(lcid), flags, StrPtr(CStr(value)), VarPtr(customFormat), bufferPtr, MAX_BUFFER_LENGTH)
If charCount > 0 Then
ReDim Preserve buffer((charCount - 1) * CHAR_LENGTH)
FormatNumberCustom = buffer
Else
Select Case Err.LastDllError
Case ERROR_INSUFFICIENT_BUFFER
Err.Raise Err.LastDllError, "FormatNumberCustom", "A supplied buffer size was not large enough, or it was incorrectly set to NULL."
Case ERROR_INVALID_FLAGS
Err.Raise Err.LastDllError, "FormatNumberCustom", "The values supplied for flags were not valid."
Case ERROR_INVALID_PARAMETER
Err.Raise Err.LastDllError, "FormatNumberCustom", "Any of the parameter values was invalid."
Case ERROR_OUTOFMEMORY
Err.Raise Err.LastDllError, "FormatNumberCustom", "Not enough storage was available to complete this operation."
Case Else
Err.Raise Err.LastDllError, "FormatNumberCustom", "Unexpected error occurred."
End Select
End If
End Function
Public Sub CustomFormatNumberTest()
Dim value As Double
Dim lcid As String
Dim customFormat As String
value = -12345.678
Dim decimalSeparator As String
decimalSeparator = "@"
Dim thousandSepartor As String
thousandSepartor = "#"
Dim customNumberFormat As NumberFormat
customNumberFormat.NumDigits = 2 '
customNumberFormat.LeadingZero = 1 'Leading zero's
customNumberFormat.Grouping = 3
customNumberFormat.lpDecimalSep = StrPtr(decimalSeparator)
customNumberFormat.lpThousandSep = StrPtr(thousandSepartor)
customNumberFormat.NegativeOrder = 4 'Number, space, negative sign; for example, 1.1 -
lcid = "de-DE"
customFormat = FormatNumberCustom(value, lcid, 0, customNumberFormat)
Debug.Print " Value: " & value
Debug.Print " Custom format value : " & customFormat
Debug.Print " System Local Name: " & lcid
Debug.Print
lcid = "en-AU"
customFormat = FormatNumberCustom(value, lcid, 0, customNumberFormat)
Debug.Print " Value: " & value
Debug.Print " Custom format value : " & customFormat
Debug.Print " System Local Name: " & lcid
Debug.Print
value = 12345.678
lcid = "en-AU"
customFormat = FormatNumberCustom(value, lcid, 0, customNumberFormat)
Debug.Print " Value: " & value
Debug.Print " Custom format value : " & customFormat
Debug.Print " System Local Name: " & lcid
Debug.Print
End Sub
'Output:
' Value: -12345.678
' Custom format value : 12#345@68 -
' System Local Name: de-DE
'
' Value: -12345.678
' Custom format value : 12#345@68 -
' System Local Name: en-AU
'
' Value: 12345.678
' Custom format value : 12#345@68
' System Local Name: en-AU
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论