Hi
We've got a couple of dialogs that we are opening from the windows API, for example the File Dialog and the 'Select Color Dialog'.
It works fine in Windows 32 bit and 64 bit, but if you install Office 64 bit it fails.
It asks that you add the PtrSafe keyword to your declarations. If I do that, the compile errors go away, but the dialogs are still not opening.
Below is our code to open a 'Select a Color Dialog' form. How can we make it work with Office 64 bit?
Private Type ChooseColorStruct
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
(lpChoosecolor As ChooseColorStruct) As Long
Private Declare PtrSafe Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor _
As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Const CC_RGBINIT = &H1&
Private Const CC_FULLOPEN = &H2&
Private Const CC_PREVENTFULLOPEN = &H4&
Private Const CC_SHOWHELP = &H8&
Private Const CC_ENABLEHOOK = &H10&
Private Const CC_ENABLETEMPLATE = &H20&
Private Const CC_ENABLETEMPLATEHANDLE = &H40&
Private Const CC_SOLIDCOLOR = &H80&
Private Const CC_ANYCOLOR = &H100&
Private Const CLR_INVALID = &HFFFF
Function GetColour(Optional ByVal hParent As Long, Optional ByVal bFullOpen As Boolean, Optional ByVal InitColor As OLE_COLOR) As Long
Dim CC As ChooseColorStruct
Dim aColorRef(15) As Long
Dim lInitColor As Long
'Translate the initial OLE color to a long value
If InitColor <> 0 Then
If OleTranslateColor(InitColor, 0, lInitColor) Then
lInitColor = CLR_INVALID
End If
End If
'Fill the ChooseColorStruct struct
With CC
.lStructSize = Len(CC)
.hwndOwner = hParent
.lpCustColors = CLng(VarPtr(aColorRef(0)))
.rgbResult = lInitColor
.flags = CC_SOLIDCOLOR Or CC_ANYCOLOR Or CC_RGBINIT Or IIf(bFullOpen, CC_FULLOPEN, 0)
End With
'Show the dialog
If ChooseColor(CC) Then
GetColour = CC.rgbResult
Else 'Cancelled
GetColour = -1
End If
End Function
We've got a couple of dialogs that we are opening from the windows API, for example the File Dialog and the 'Select Color Dialog'.
It works fine in Windows 32 bit and 64 bit, but if you install Office 64 bit it fails.
It asks that you add the PtrSafe keyword to your declarations. If I do that, the compile errors go away, but the dialogs are still not opening.
Below is our code to open a 'Select a Color Dialog' form. How can we make it work with Office 64 bit?
Private Type ChooseColorStruct
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
(lpChoosecolor As ChooseColorStruct) As Long
Private Declare PtrSafe Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor _
As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Const CC_RGBINIT = &H1&
Private Const CC_FULLOPEN = &H2&
Private Const CC_PREVENTFULLOPEN = &H4&
Private Const CC_SHOWHELP = &H8&
Private Const CC_ENABLEHOOK = &H10&
Private Const CC_ENABLETEMPLATE = &H20&
Private Const CC_ENABLETEMPLATEHANDLE = &H40&
Private Const CC_SOLIDCOLOR = &H80&
Private Const CC_ANYCOLOR = &H100&
Private Const CLR_INVALID = &HFFFF
Function GetColour(Optional ByVal hParent As Long, Optional ByVal bFullOpen As Boolean, Optional ByVal InitColor As OLE_COLOR) As Long
Dim CC As ChooseColorStruct
Dim aColorRef(15) As Long
Dim lInitColor As Long
'Translate the initial OLE color to a long value
If InitColor <> 0 Then
If OleTranslateColor(InitColor, 0, lInitColor) Then
lInitColor = CLR_INVALID
End If
End If
'Fill the ChooseColorStruct struct
With CC
.lStructSize = Len(CC)
.hwndOwner = hParent
.lpCustColors = CLng(VarPtr(aColorRef(0)))
.rgbResult = lInitColor
.flags = CC_SOLIDCOLOR Or CC_ANYCOLOR Or CC_RGBINIT Or IIf(bFullOpen, CC_FULLOPEN, 0)
End With
'Show the dialog
If ChooseColor(CC) Then
GetColour = CC.rgbResult
Else 'Cancelled
GetColour = -1
End If
End Function