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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/5724396/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 13:03:56  来源:igfitidea点击:

Excel 64-bit and comdlg32.dll custom colours

vbaexcel-vbaexcel

提问by osknows

I'm trying to adapt the code in either hereor hereto open the custom colour palette in Excel 2010 64-bit but cannot get it to work. Code on both sites work fine in Excel 2003

我正在尝试调整此处此处的代码以在 Excel 2010 64 位中打开自定义调色板,但无法使其正常工作。两个站点上的代码在 Excel 2003 中都可以正常工作

One attempt

一次尝试

 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

This runs ok but doesn't show the dialog. I've also tried changing some LONG types to LONGPTR with no success. Does anyone know how to get this working on a 64-bit machine; or if it's even possible? Perhaps there's a new library?

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

Thanks

谢谢

Edit:Slight rewording with offer of bounty... How do I access and use this custom colour chooser (image below) in Excel 2010 64-bit (MUST work on 64-bit!) to set cells in Excel 2010 with the colour chosen and store the colour? The image is taken from Excel 2010 64-bit by selecting fill button>more colors>Custom

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

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

有效的 XHTML http://img851.imageshack.us/img851/2057/unlednvn.png

回答by Thomas

Two things I would try. First, replace every use of Longwith LongPtr.

我会尝试两件事。首先,更换一个要使用LongLongPtr

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

Second, replace the use of Lenwith LenB.

其次,替换使用Lenwith 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

More Info

更多信息

LongPtr Data Type

LongPtr 数据类型

LenB Function

LenB 函数

回答by Johan

AFAIK 32-bit dll's cannot be used by a 64-bit application.
Use comdlg64.dll instead (if there is such a dll).

AFAIK 32 位 dll 不能被 64 位应用程序使用。
改用 comdlg64.dll(如果有这样的 dll)。

Using google reveals that there a host of viruses floating around on the net by that name.
So if comdlg64.dllis not on your machine don't download itfrom the net!
(Unless you want to experience zombieness).

使用谷歌显示,有许多病毒以该名称在网上流传。
因此,如果comdlg64.dll不在您的机器上,请不要从网上下载它
(除非你想体验僵尸)。