无法让拾色器在 Excel 2010 64 位中工作

Question

您好，我正在努力为 Excel 2010 64 位更新 VBA 代码。我已经检查了所有内容，包括 * 上的一篇信息性帖子：* Question 我明白我必须声明 PtrSafe 并在适用的情况下创建 LongPtr 和 LongLong，但我在私有函数代码的“.rgbResult”部分收到“编译错误。类型不匹配”。任何任何和所有的帮助将不胜感激。我的代码如下：

Option Explicit
#If VBA7 Then
     #If Win64 Then
        Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As LongPtr
        Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Type ChooseColor
            lStructSize As LongPtr
            hwndOwner As LongPtr
            hInstance As LongPtr
            rgbResult As LongPtr
            lpCustColors As String
            flags As LongPtr
            lCustData As LongPtr
            lpfnHook As LongPtr
            lpTemplateName As String
            End Type
      #Else
       '{{{This Section of Code works ok so i have excluded it to save space as its the same as above without the ptr}}}}}
      #End If
#Else
        '{{{This Section of Code works ok so i have excluded it to save space}}}}}
#End If


#If VBA7 Then
     #If Win64 Then
            Private Declare PtrSafe Function ShowColor Lib "comdlg32.dll" Alias "ShowColorA" (pShowColor As ShowColor) As LongPtr
                Dim ChooseColorStructure As ChooseColor
                Dim Custcolor(16) As LongPtr
                Dim lReturn As LongPtr

                                        On Error GoTo ErrEnd:
                ChooseColorStructure.lStructSize = LenB(ChooseColorStructure)
                ChooseColorStructure.hwndOwner = FindWindow("XLMAIN", Application.Caption)
                ChooseColorStructure.hInstance = 0
                ChooseColorStructure.lpCustColors = StrConv(Custcolor(16), vbUnicode)
                ChooseColorStructure.flags = 0
                If ChooseColor(ChooseColorStructure) <> 0 Then
                    ShowColor = ChooseColorStructure.rgbResult

                    Custcolor(16) = StrConv(ChooseColorStructure.lpCustColors, vbFromUnicode)
                    On Error GoTo 0
                Else
                    ShowColor = -1
                End If
ErrEnd:
         End Function
    #Else
           '{{{This Section of Code works ok so i have excluded it to save space}}}}}
         #End If
#Else
             '{{{This Section of Code works ok so i have excluded it to save space}}}}}

            End Function

Answer 1

在搜索了更多之后，我很确定 ChooseColor 实际上应该是 as Long 而不是 as LongPtr

我在 Google 上搜索了声明的引号：“Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As LongPtr”

我只得到 2 个结果：这个问题，以及其他网站上的帖子，但我无法阅读它，因为它是法语，我一直想学习但没有。

我用“Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long”进行了搜索，我得到了更多的结果，所以我认为它应该声明为 long 而不是 longPtr。即使在 64 中，有些仍然需要返回 longs 而不是 longPtr

编辑

这个页面：http://www.jkp-ads.com/articles/apideclarations.asp?AllComments=True 在 cmets 中提到了 chooseColor 函数，他们用 As Long 声明了它，而不是那里的 longPtr。以防万一您需要参考:)

Answer 2

   lStructSize As LongPtr

您过分声明成员 LongPtr 而不是 Long。 LongPtr 应该只在成员是 pointer 或 handle 类型时使用，lStructSize 不是指针。其他几个成员也是如此，包括 rgbResult。它需要看起来像这样：

    Private Type ChooseColor
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        rgbResult As Long
        lpCustColors As LongPtr
        flags As Long
        lCustData As LongPtr
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type