Excel 64位和comdlg32.dll自定义颜色

时间:2011-04-20 00:46:48

标签: vba excel-vba excel

我尝试调整herehere中的代码以在Excel 2010 64位中打开自定义调色板但无法使其工作。两个站点上的代码在Excel 2003中运行良好

一次尝试

 Option Explicit

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

 Private Declare PtrSafe Function ChooseColorAPI Lib "comdlg32.dll" Alias _
 "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long

 Dim CustomColors() As Byte

 Private Sub Command1_Click()
   Dim cc As CHOOSECOLOR
   Dim Custcolor(16) As Long
   Dim lReturn As Long
   cc.lStructSize = Len(cc)
   cc.hwndOwner = Application.Hwnd
   cc.hInstance = 0
   cc.lpCustColors = StrConv(CustomColors, vbUnicode)
   cc.flags = 0
   lReturn = ChooseColorAPI(cc)
   If lReturn <> 0 Then
       Application.Caption = "RGB Value User Chose: " & Str$(cc.rgbResult)
       Application.BackColor = cc.rgbResult            ' Visual Basic only ****
       Application.Section(0).BackColor = cc.rgbResult ' Access only **********
       CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
   Else
       MsgBox "User chose the Cancel Button"
   End If
   End Sub

   Private Sub Form_Load()
   ReDim CustomColors(0 To 16 * 4 - 1) As Byte
   Dim i As Integer

   For i = LBound(CustomColors) To UBound(CustomColors)
       CustomColors(i) = 0
   Next i
   End Sub

这样运行正常,但没有显示对话框。我也尝试将一些LONG类型更改为LONGPTR但没有成功。有谁知道如何在64位机器上工作;或者如果可能的话?也许有一个新的图书馆?

由于

编辑:通过提供赏金轻微重写... 如何在Excel 2010 64位中访问和使用此自定义颜色选择器(下图)(必须在64位上工作!)在Excel 2010中使用所选颜色设置单元格并存储颜色?通过选择填充按钮&gt;更多颜色&gt;自定义

,从Excel 2010 64位中获取图像

Valid XHTML http://img851.imageshack.us/img851/2057/unlednvn.png

2 个答案:

答案 0 :(得分:6)

我会尝试两件事。首先,将Long的每次使用替换为LongPtr

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

Private Declare PtrSafe Function ChooseColorAPI Lib "comdlg32.dll" Alias _
    "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As LongPtr

其次,将Len替换为LenB

Private Sub Command1_Click()
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As LongPtr
    Dim lReturn As LongPtr

    cc.lStructSize = LenB(cc)
    cc.hwndOwner = Application.Hwnd
    cc.hInstance = 0
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.flags = 0
    lReturn = ChooseColorAPI(cc)

    If lReturn <> 0 Then
       Application.Caption = "RGB Value User Chose: " & Str$(cc.rgbResult)
       Application.BackColor = cc.rgbResult            ' Visual Basic only ****
       Application.Section(0).BackColor = cc.rgbResult ' Access only **********
       CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else
       MsgBox "User chose the Cancel Button"

    End If
End Sub

Private Sub Form_Load()
    ReDim CustomColors(0 To 16 * 4 - 1) As Byte
    Dim i As Integer

    For i = LBound(CustomColors) To UBound(CustomColors)
       CustomColors(i) = 0
    Next i
End Sub

更多信息

LongPtr Data Type

LenB Function

答案 1 :(得分:1)

64位应用程序无法使用AFAIK 32位dll 请改用comdlg64.dll(如果有这样的dll)。

使用谷歌显示网络上有大量病毒以该名称浮动 因此,如果您的计算机上没有comdlg64.dll 请勿从网上下载(除非你想体验僵尸)。