تعديل كود يعمل على اوفيس 32بت ولا يعمل على اوفيس 64 بت

[jo_2010]

الخبراء الافاضل

برجاء مساعدتى فلا حل هذة المشكلة

المطلوب فى الصورة الاولى

المشكلة التى اقابلها فى الصورة الثانية

Database1.accdb

[Foksh]

وعليكم السلام ورحمة الله وبركاته ..

تفضل أخي جو التعديل كالآتي :-

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As LongPtr, ByRef rgb As Long)
#Else
    Private Declare Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As Long, ByRef rgb As Long)
#End If

Function DialogColor(ByVal InitialColor As Long) As Long
    Dim lngColor As Long
    lngColor = InitialColor
    Call ChooseColor(Application.hWndAccessApp, lngColor)
    DialogColor = lngColor
End Function

 

ملفك المرفق .. جربه وأخبرني

Database1.accdb

[kkhalifa1960]

كودك صحيح من ناحية التركيب والمنطق، لكن هناك ملاحظات مهمة:

1. الاستخدام العملي

هذا الكود يستدعي دالة داخلية غير موثقة (#53) في msaccess.exe لعرض صندوق حوار اختيار الألوان.
هل ستنجح؟

• على الأرجح لا، لأن الدالة الداخلية #53 قد تكون غير موجودة أو لا تقوم بما تظن.

• الطريقة الصحيحة والمستقرة هي استخدام Comdlg32.dll (ChooseColor API).

2. النظام الصحيح باستخدام API ويندوز

بدلاً من ذلك، استخدم هذا الكود الموثوق:

' في بداية الموديول
#If VBA7 Then
    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#Else
    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#End If

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

Function DialogColor(Optional ByVal InitialColor As Long = &H0) As Long
    Dim cc As CHOOSECOLOR
    Dim CustColors(0 To 15) As Long
    
    cc.lStructSize = Len(cc)
    cc.hwndOwner = Application.hWndAccessApp
    cc.rgbResult = InitialColor
    cc.lpCustColors = VarPtr(CustColors(0))
    cc.Flags = &H2   ' CC_RGBINIT
    
    If ChooseColor(cc) <> 0 Then
        DialogColor = cc.rgbResult
    Else
        DialogColor = InitialColor   ' إذا تم الإلغاء
    End If
End Function

تفضل مرفقك بعد التعديل .ووافني بالرد .

Database1-1.accdb

تم تعديل منذ 5 ساعات بواسطه kkhalifa1960

[قلم.رصاص]

13 دقائق مضت, kkhalifa1960 said:

1. الاستخدام العملي

هذا الكود يستدعي دالة داخلية غير موثقة (#53) في msaccess.exe لعرض صندوق حوار اختيار الألوان.
هل ستنجح؟

• على الأرجح لا، لأن الدالة الداخلية #53 قد تكون غير موجودة أو لا تقوم بما تظن.

• الطريقة الصحيحة والمستقرة هي استخدام Comdlg32.dll (ChooseColor API).

2. النظام الصحيح باستخدام API ويندوز

اوجزت فأحسنت وأبدعت

[Foksh]

39 دقائق مضت, kkhalifa1960 said:

كودك صحيح من ناحية التركيب والمنطق

حاولت فعلاً أن أستنبط فكرتكم بكل صدق لأثري معلومتي . وكانت تجربتي أن الفكرة على الإصدار 64 لا تعمل للأسف ، ولكنها تعمل على الإصدار 32 فعلاً .. وهذا توضيح لمقصدي .

 

[منتصر الانسي]

50 دقائق مضت, Foksh said:

حاولت فعلاً أن أستنبط فكرتكم بكل صدق لأثري معلومتي . وكانت تجربتي أن الفكرة على الإصدار 64 لا تعمل للأسف ، ولكنها تعمل على الإصدار 32 فعلاً .. وهذا توضيح لمقصدي .

بالفعل لم تعمل معي

[jjafferr]

اليك كودك بعد التصحيح:

بدلا عن

Function DialogColor(rgb As Long) As Long
  Call ChooseColor(Application.hWndAccessApp, rgb)
  DialogColor = rgb
End Function
  
  استعمل
#If VBA7 Then
    Function DialogColor(rgb As LongPtr) As LongPtr
#Else
    Function DialogColor(rgb As Long) As Long
#End If

  Call ChooseColor(Application.hWndAccessApp, rgb)
  DialogColor = rgb
End Function

.

والسبب:

عند استعمال 64بت ، المتغير يصبح rgb As LongPtr

وعليه ، يجب عمل الدالة DialogColor بنفس rgb

1643.FileDialog.accdb