تعديل كود يعمل على اوفيس 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

تم تعديل بالامس في 16:16 بواسطه 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  (لاحظ انه المتغير رقم 2 في الدالة ChooseColor) والدالة ChooseColor يصبحون LongPtr ،

وعليه ، وفي الدالة DialogColor ، فاننا ننادي الدالة ChooseColor ، والمتغير رقم 2 هو rgb ، فيجب ان يكون نفس نوع rgb الـ 64بت ، وهو LongPtr ،

وعند اعطائنا قيمة rgb الى DialogColor (في المعادلة DialogColor=rgb) ، فيجب ان DialongColor تصبح LongPtr ايضا.

لذلك في حالة 64 بت ، يجب استعمال 
Function DialogColor(rgb As LongPtr) As LongPtr

1643.FileDialog.accdb

تم تعديل منذ 11 ساعات بواسطه jjafferr
توضيح اكثر

[jjafferr]

الطريقة الاخرى هي ، اضافة PtrSafe في السطر الثالث فقط ، وبدون تغيير الدالة DialogColor ، هكذا :

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

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

 

1643.1.FileDialog.accdb

[Foksh]

36 دقائق مضت, jjafferr said:

rgb

أليس هذا ما يمثل اللون المختار ؟؟

فكيف نحدده على انه LongPtr 🤔 !!

 

مقصدي أن :-

* المتغير rgb يظل Long لأنه مجرد قيمة لون ( 32‑بت ) .

* المتغير Hwnd يجب أن يكون LongPtr في بيئة 64 لأنه مؤشر .

* يجب أن يكون هناك تطابق بين تعريف الـ API وتعريف الدالة .

 

هذا على حد علمي 😇 ، والله أعلم .

تم تعديل منذ 1 ساعه بواسطه Foksh

[jjafferr]

 

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

أليس هذا ما يمثل اللون المختار ؟؟

نعم ، ولكنه يعتمد api النواة :

اقتباس

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

 

[Foksh]

قد يكون كذلك ، كانت عندي النقطة المفصلية أنك جعلت rgb As LongPtr في حالة VBA7 ، وهذا غير صحيح لأن اللون ليس Pointer 🤔 . وباعتقادي أن الصحيح هو بقاء rgb As Long دائماً ، بينما الـ Hwnd هو الذي يتغير بين Long و LongPtr .

 

لم أجرب تعديلك لتأكيد وتصويب معلومتي ، فعذراً منكم أستاذي جعفر 😇 .