نجوم المشاركات

علم البرمجة 80% ممارسة .. و 20% دراسة نظرية الدراسة النظرية المكثفة مع ممارسة قليلة .. نهايتها النسيان الأشياء التي ترسخ بالذاكرة هي الاشياء التي تكتشفها او تصل اليها بالمحاولة والخطأ منتدى اكسس اوفيسنا هو اكبر صرح تعليمي على مستوى الوطن العربي .. وبالمجان اذا اتبع الشخص طرق التعلم الصحيحة من الصفر .. سوف يصل الى الاحتراف في مدة وجيزة الطريقة .. هي بناء مشروع يكون هو فعلا بحاجته .. او بتكليف من شخص آخر يحتاجه لأن التعلم من اجل التعلم فقط تضعف الهمة فيه غالبا وهذا شيء مجرب .. بسبب فقد الحافز

تفضل اخى جرب واعلمنى بالنتيجة تم اضافة اعادة ترتيب البيانات تصاعديا حسب التاريخ جرب الكود والملف تعديل جلب التفاصيل.xlsm

المرفق بعد اتمته............ جلب صورة من الانترنت وحفظها باسم جديد ومسار جديد بالجدول وحفظها بمجلد بجوار القاعدة . GetImageTest1-2.rar

السلام عليكم متابع عن بعد وفى صمت حتى ارى مثال الاجنبى للاستاذ/ @Mehr@ban

كيف تفرغه وهو مرتبط ؟؟؟

ضع ما شئت من الأزرار 🙂 ولكن مع مراعاة الشرط والسر الرئيسي وهو ( مسميات الأزرار ) لاحظ أن أسماء الأزرار لها تسلسل واضح .. فقط عندما تضيف أي زر رئيسي أو فرعي تراعي نفس النسق في التسمية .. وبعدها الكود سيتعرف بنفسه على الأزرار الفرعية لكل زر رئيسي 🙂 ولو أضفت أزرار رئيسية جديدة .. لا تنسى تضيف أسم الدالة في حدث عند النقر: ‏‏صفحة رئيسية مطورة - النموذج الثاني.accdb

تفضل حل اخر لاثراء الموضوع Sub Filter_month2() Dim Cpt As Long, rgFound As Range Dim cel As Range, Rng As Range, Clé As Range Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("1") Dim desWS As Worksheet: Set desWS = ThisWorkbook.Sheets("2") lastRow = WS.Range("B" & Rows.Count).End(xlUp).Row Set Clé = desWS.Range("L2") Set Rng = WS.Range("B3:B" & lastRow) For Each cel In Rng If Month(cel) = Month(Clé) Then Set rgFound = cel Exit For End If Next cel If rgFound Is Nothing Then MsgBox "لا توجد بيانات لشهر" & " :" & Month(Clé), vbOKOnly + vbExclamation, "admin" Exit Sub End If desWS.Range("B5:M" & Rows.Count).ClearContents For Col = 3 To lastRow If IsDate(WS.Range("B" & Col).Value) = True Then If Month(WS.Range("B" & Col).Value) = Month(Clé) Then Cpt = desWS.Range("b" & Rows.Count).End(xlUp).Row + 1 desWS.Range("B" & Cpt & ":M" & Cpt).Value = WS.Range("A" & Col & ":L" & Col).Value End If End If Next Application.ScreenUpdating = True End Sub

=IF($C1="مسلم",IF(OR($B1="مسيحي ك1",$B1="مسيحي ك2"),"",1),IF($C1="مسيحي",IF(OR($B1="اسلامي ك1",$B1="اسلامي ك2"),"",1),""))

جزاكم الله خيرا بالفعل وضح الفرق بينهما هل يمكنكم مساعدتي في توضيح السؤال الاول بطريقة مبسطة بارك الله فيكم

للأسف، لا يوجد برنامج أو موقع يوفر ملفًا يمكن إضافته إلى Excel 2016 لإضافة جميع المعادلات الجديدة المتوفرة في النسخ الأحدث من Office. الأفضل في هذه الحالة هو استخدام المعادلات والوظائف المتاحة في Excel 2016 والبحث عن حلول بديلة للمهام التي قد تحتاج إلى وظائف جديدة. إذا كانت لديك أي وظيفة محددة تبحث عنها، فلا تتردد في طرحها هنا للحصول على المساعدة في إيجاد حلول بديلة لها.

لا أعتقد ذلك 🤗

بارك الله لك استاذنا ابوالحسن جميل ما شاء الله أحسنت

استاذ @Foksh كما شئت انطلق .

تأكد من اسم مستخدم سيكوال سيرفر وكلمة السر

جرب طبقاً للوصف السابق، يمكنك اتباع الخطوات التالية: . ضع هذا الكود Dim soundPlayed As Boolean Sub ActivateTimer() soundPlayed = False ' Your existing code to activate the current time End Sub Sub CheckTime() Dim i As Integer For i = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("N" & i).Value > Range("L" & i).Value And Not soundPlayed Then Beep ' تشغيل الصوت هنا soundPlayed = True End If Next i End Sub Sub ResetSound() soundPlayed = False End Sub . قم بتعديل الكود الموجود لديك ليتناسب مع الكود المعطى. ابحث عن الجزء الذي يقوم بحساب الوقت وتحديد نهايته، واستبدله بالكود الجديد الموجود في الدالة `CheckTime`. . قم بإضافة زر في ورقة العمل لتفعيل الوقت باستخدام الدالة `ActivateTimer`. . قم بتعيين زر آخر لإعادة تهيئة المتغير `soundPlayed` باستخدام الدالة `ResetSound`. هذا الكود سيقوم بتشغيل التنبيه الصوتي مرة واحدة فقط عندما يتم اكتشاف انتهاء الوقت المحدد لكل شاشة.

مرحبابك استاذ @Ahmed_J هناك اشكالية ادارية في ملفك ...وهو انه ليس بالضرورة ان تكون درجة خبير او معاون مدير عام بالدرجة الاولى انا مثلا ..منذ 3 سنوات في الدرجة الاولى (رئيس مهندسين اقدم)...اما معاون مدير عام فيكون بالتعيين من قبل المسؤول وليس له علاقة بالخدمة رأيي ان يتم اختيار العنوان الوظيفي يدويا من خلال مربع التحرير وحسب الاوامر الادارية وليس برمجيا تحياتي لك

استخدم المعادلة التالية لحذف المسافات الزائدة بين الكلمة (قبل وبعد) =TRIM(SUBSTITUTE(SUBSTITUTE(B2;CHAR(160);" ");"^"&TRIM(SUBSTITUTE(B2;" ";"^"));"")) يرجى العلم استبدال الفاصلة حسب إعدادات الكمبيوتر( , أو ; )

تمام اخي لقد فهمت طلبك بشكل خاطئ اظن ان حل الاستاد @احمد عبدالحليم سيوفي بالغرض بالتوفيق

طيب استاذي الفاضل انظر المرفق ربما يوحي لك الفكرة التى اردت ايصالها لك .... Test-1.accdb

حتى لا يتشعب الموضوع في أذهان من يقرأ الموضوع ، تعبر Null عن عدم وجود قيمة صالحة أو حقيقية . فإذا كانت قيمة حقل معين تحتوي على Null ، فهذا يعني أنه لا توجد قيمة محددة لهذا الحقل . فالقيمة Null ليست نصًا فارغًا ، اعتبرها حالة خاصة حيث لا وجود لقيمة صالحة فيها. أما القيمة الفارغة ( "" ) فهي تعبر عن نص فارغ من قيم رقمية أو فارغ من القيم النصية ( الحروف ) . حيث يستخدم الرمز "" لتمثيل النص الفارغ . باختصار القيمة الفارغة هي قيمة نصية فارغة ( والفراغ يعتبر حرفاً في الحروف أو النصوص ) وليست Null. وعليه فإن إجابةً لسؤالك أعلاه في الجملة الشرطية في الكود الأول ، يتم فحص إذا كانت القيمة فارغة ("") ، بينما في الكود الثاني يتم فحص إذا كانت القيمة تمثل Null . الشق الثاني سأقوم بتجهيز مرفق وارفاقه في مشاركة أخرى إن شاء الله طبعاً إجتهاداً مما تعلمته أو فهمته ، وقد أكون مخطئاً في التعبير

Null و "" شيئان مختلفان حتى من حيث تعامل الأكسس معهما 🙂 أنصحك بمشاهدة هذه الفيديوات ( هي باللغة الإنجليزية ولكن ممكن تشغل الترجمة بالعربية ) :

السلام عليكم استاذ @ناقل المحترم انا اعرف هذه الطريقة ولدي ملف خاص بها انا اردت فقط التاكد كيف يمكن تدقيق العنوان والدرجة في النموذج من خلال الجدول تحياتي لك استاذ بارك الله فيك

لا مانع من التعلم بأي لغة أخي الكريم ، ارسل المرفق ان استطعت الذي تتحدث عنه ، ولنر كيفيه الفكرة التي اعتمدها صاحب المشروع في المنتدى الأجنبي . ورأيي قد ذكرته سابقاً ( الموضوع جيد والفكرة جميلة لحماية البيانات وهي الأهم بالنسبة للمستخدم ) ؛ ولكن تذكر فكرة أن آكسيس نفسها لم تقم بتقديم الحلول لحماية البيانات كونها من حق المستخدم في الحصول عليها متى شاء .

أعتقد الكثيرين خطرت لهم هذه الفكرة ، وهي جيدة جداً لو لم يكن المشروع يعتمد على اي نوع من الإستعلامات . فمثلاً وسبق لي التجربة على مشروع الأخ الدكتور @الحلبي - بأن يتم تخزين المعلومات في الجداول بطريقة مشفره ، ويتم عرضها بشكل عكسي في النماذج عند طلبها مباشرة من الجدول دون وسيط ( إستعلام ). لكن عند تنفيذ الإستعلامات والمعايير والشروط ... الخ ، فإنك ستجد مشكلة في فك التشفير داخل الاستعلام ..... بالإضافة إلا أن الفكرة قد تكون ناجحة في بداية الأمر . ولكن عند تراكم السجلات والبيانات وكثرتها في الجداول ستجد أن الموضوع يأخذ وقتأ أطول كل مرة وأن البرنامج أصبح ثقيلاً جداً. هذا من وجهة نظري طبعاً

الفضل لله .. لم افهم .. فالحقل BuyerName وضعته في جدول المتابعة فقط .. وهو يمثل حقل الاسم في النموذج الرئيسي .. آأأأه تقصد في نموذج عرض التغييرات بالعكس اذا يوجد اضافة جميل ان ترفعها هنا فنحن جميعا نتعلم ونساعد بعض

الله يرضى عليك تسلم - الكود ا- ممتاز تمام جربت الكود على بياناتي 100 % جزيت خيرا

لا ابخل على منتدانا وأخواني والأساتذة أبداً .. آن الأوان يا صديقي 😁😂 الملف مفتوح المصدر ، فقط الدعاء لوالديّ Smart Alarm.zip باب الحوار مفتوح للمناقشة ، والضيافة عند الأستاذ @Moosak

استاذي نفرغه حتى من جدول person اهتديت لحل في بداية الادخال بقاعدة البينات عندما تصفر نهائيا وه و في حال عدم وجود الاسم يتم يحفظه واضافته كما في الكود ادناه Private Sub t2_NotInList(NewData As String, Response As Integer) If (MsgBox("الإسم غير موجود " & vbCrLf & "هل تريد اضافته", vbInformation + vbMsgBoxRight + vbYesNo, "النظام") = vbYes) Then DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO person( nam ) Values('" & Me.t2.Text & "');" DoCmd.SetWarnings True Response = acDataErrAdded Else Response = acDataErrContinue Me.t2.Undo End If End Sub

شرح وافي جزاك الله خيرا كان ينقصني فهم خطوات الاجراء ... فالمتعة تأتي حين تستوعب عمل الكود بناء على التسمية العامة يتم اخفاء جميع الازرار الفرعية وبناء على التسمية العامة + رقم زر القسم يتم اظهار الازرار الفرعية لهذا القسم عمل جميل اعجبني وهو نموذجي لمن اراد القوائم العمودية

استاذ @العبيدي رعد المرفق يعمل تمام ومافي رسائل ......... تابع الفيديو . قروض 3-1.rar

ابحث عنك وجابك الله نصيدك في هذه الزحمة هذا مثال لك اعجبني جدا ضمن الرابط الذي وضعه اخونا @Foksh يشتمل على 6 اقسام ويندرج تحت كل قسم فرعين ماذا لو كل قسم اختلف عدد الازرار الفرعية فيه عن الآخر ؟ مثلا نريد تحت القسم الاول 4 ازرار فرعية وتحت القسم الثاني زر واحد وتحت الثالث 2 زرين ... وهكذا حسب الحاجة صفحة رئيسية مطورة 2.rar

تفضل التغيرات2.rar

أزاحم الكبار فقط 😅 عمل قوائم ديناميكية متحركة :: طريقة مبتكرة بأقل كمية أكواد vba

رائع رائع باشمهندس 😉👌🏼 وتم إضافة التحديث في المشاركة الرئيسية .. 🙂 أما آن الأوان لكشف الأسرار 😁😂

وايضا في هذا المكان ان كان للابداع وصف

تفضل اخي اليك حل اخر ربما هدا ما تقصده Sub OterDoublons() Dim der As Long, j As Long, Lastrow As Long Application.ScreenUpdating = False Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("البيانات") Dim desWS As Worksheet: Set desWS = ThisWorkbook.Sheets("ارقام") Lastrow = WS.Cells(WS.Rows.Count, "O").End(xlUp).Row desWS.Range("A2:C" & Rows.Count).ClearContents WS.Range("O2:Q" & Lastrow).Copy _ Destination:=desWS.Range("A2") With desWS If .FilterMode Then .ShowAllData For j = 1 To Range("C2").Column der = .Cells(.Rows.Count, j).End(xlUp).Row If der >= 2 Then .Cells(1, j).Resize(der).RemoveDuplicates Columns:=1, Header:=xlYes Next j End With Application.ScreenUpdating = True End Sub جلب التفاصيل V2.xlsm

مقتبساً عن استاذنا الفاضل ومعلمنا @ابوخليل هنا ستجد ما لذ وطاب بكل تأكيد

ادن اخي يجب التحقق اولا من تنسيق خلية اسم الشهر .اليك الملف عليه الكود يمكنك تطويعه بما يناسبك Sub Filter_month() Dim lr&, i&, j&, c& Dim arr As Variant, K As Variant Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("1") Dim desWS As Worksheet: Set desWS = ThisWorkbook.Sheets("2") lastrow = desWS.Range("b" & Rows.Count).End(xlUp).Row clé = desWS.[L2] If clé = 0 Then MsgBox "المرجوا تحديد شهر الفلترة", vbExclamation: Exit Sub Application.ScreenUpdating = False lr = WS.Range("B" & Rows.Count).End(xlUp).Row On Error Resume Next arr = WS.Range("A3:L" & lr).Value ReDim K(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) If Month(arr(i, 2)) = Month(clé) Then desWS.Range("B5:M" & Rows.Count).ClearContents For c = LBound(arr, 2) To UBound(arr, 2) K(j, c) = arr(i, c) Next c j = j + 1 End If Next i desWS.Range("b5").Resize(j - 1, UBound(K, 2)).Value = K If Err <> 0 Then MsgBox "لا توجد بيانات لشهر" & " :" & Month(clé), vbExclamation, "admin" End Sub Filter_month.xlsb

كنت عايز اتعلم ويكون ليك الفضل كيف اكون محترف مثلك فى vba 01273263994 ارجوا ارسال رسالة على الواتس لاتمكن من الشكر شخصيا

مداعبة ............... هتاخد الملف وش وحرف بعد ماتربطه بالفتيل !!!!!!!!!!!!!1 . تحياتي .

لاحظ معي هل تنفعك هذه الطريقة ......

السلام عليكم عيدكم مبارك بالمرفق كود يقوم نيابة عنك بإكمال البيان الذي تكتبه في عمود معين بورقة عمل استناداً لمجال معين بورقة عمل آخري منفصلة. كيف ؟؟؟؟ الشرح : 1- قم بتدوين البيانات التي تريدها في المجال المسمى AutoCompleteText ضمن العمود A بالورقة المسماة Source data يجب أن تكون البيانات المدخلة غير مكررة . 2- الان انتقل إلى العمود A بالورقة المسماة Test sheet وقم بكتابة الأحرف الأولى المميزة والفريدة لأحد البيانات التي دونتها بالمجال السابق ثم اضغط Enter ،، سيكمل الكود البيان الذي كتبته سلفاً ،،، على سبيل المثال : اكتب حرف Z ثم اضغط Enter ستكون النتيجة في الخلية ZIAD ALI - لأنه النص الوحيد الذي يبدأ بالحرف Z ،،، واذكر بأنه ممكن أن تقوم بزيادة عدد الأعمدة التي ترغب أن يتم فيها عملية استرجاع البيانات بالصفحة المسماة Test sheet عن طريقة التعديل في الكود أرجو أن يكون المرفق مفيد للجميع ،،، ولكم كل الود والتحية. الاكمال التلقائي للبيانات.rar

للتوضيح : لاسخراج جميع الاوراق في ملف PDF واحد يتضمن جميع الطلاب ربما يتعين عليك مثلا نسخ جميع الاوراق المطبوعة لورقة اخرى اسفل بعضها البعض لتتمكن من حفظها بعد دالك . وهدا يتطلب اظافة ورقة جديدة للمصنف مع انشاء الكود الخاص بدالك . اما في حالة الرغبة في حفظها مستقلة اليك الكود التالي سيقوم بحفظ كل ورقة لوحدها في مجلد باسم شهادات الطلاب بعد تسمية كل ملف باسم الطالب الخاص به Private Sub CommandButton1_Click() Dim i As Integer, fPath As String, F As String Dim WS As Worksheet: Set WS = Sheet31 'Sheets("Sheet3 (2)") ' اسم ورقة العمل Application.ScreenUpdating = False For i = [AA12] To [AC12] If i <= [AA1] Then [AF2] = 2 * (i - 2) + 3 F = [B8] ' اسم الملف On Error Resume Next With ActiveWorkbook ' قم بتعديل اسم المجلد بما يناسبك fPath = .Path & Application.PathSeparator & "شهادات الطلاب" & Application.PathSeparator If Len(Dir(fPath, vbDirectory)) = 0 Then End If MkDir fPath WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & F & ".pdf", OpenAfterPublish:=False 'طباعة 'WS.PrintOut End With Next i Application.ScreenUpdating = True End Sub 666 PDF.xlsm

من االافضل دكر ما هي النتيجة المتوقعة من الكود جرب ربما هدا ما تقصد Sub HideRowsPrint() Dim i As Long, LastRow As Long Application.ScreenUpdating = False StartRow = 9: LastRow = 300 For i = LastRow To StartRow Step -1 If Cells(i, "C") = "" Then Rows(i).Hidden = True Next i Application.ScreenUpdating = True ActiveSheet.PrintPreview ' ActiveSheet.PrintOut Rows(StartRow & ":" & LastRow).EntireRow.Hidden = False End Sub

وعليكم السلام. للأسف، عندما يتم تحميل ملف إكسل على Google Drive، قد يتم فقدان بعض خصائص الحماية التي قمت بها في الكمبيوتر. هذا يعود إلى طريقة عمل Google Drive وتفاعله مع ملفات Office. للتحكم بصلاحيات الوصول على Google Drive، يفضل استخدام خيارات الحماية المتوفرة على المستوى الخاص بـ Google Drive نفسه، بدلاً من الاعتماد فقط على حماية الورقة أو الخلية داخل الملف. يمكنك قفل ملفك على Google Drive من خلال اختيار الخيارات المناسبة في واجهة Google Drive. لتقديم الوصول بصورة قراءة فقط، اختار "مشاركة" ثم "حدد الذين يمكنهم الوصول" وحدد "قارئ" بدلاً من "محرر".

اعتذر عن الانقطاع لظروف مرضية ان شاء الله سوف نبدأ فى الاستمرار تباعا بامر الله

السلام عليكم 🙂 اذا عملنا برنامج على الاكسس 32بت ، وفيه مكتبات الوندوز الـ 32بت (لاحظ الرقم 32 في اسم المكتبة: comdlg32.dll) ، ثم شغلنا البرنامج على اكسس 64بت ، فنحصل على هذا الخطأ : . يوجد ملف في موقع مايكروسوف (مرفق نسخة Win32API_PtrSafe.zip) ، وفيه طريقة عمل مناداة النواتين : https://www.microsoft.com/en-us/download/details.aspx?id=9970 وتوجد مواقع مجهزة الكود للنواتين ، مثل (فقط ابحث عن الدالة ، واعمل نسخ/لصق للكود) : http://www.jkp-ads.com/articles/apideclarations.asp ------------------------------------------------------------------------------------------------------------------ ولكني هنا سأناقش كيف يمكننا تعديل المكتبة بدون الرجوع لهذه الروابط (للأسف ، سنضطر للرجوع لهذه الروابط لبعض المكتبات) !! والدوال التي استعملها هنا ، هي كأمثلة فقط ، والطريقة التي سنعمل بها هي ، ان نضع برنامج 32بت فيه الدالة ، ثم نفتح البرنامج بالاكسس 64بت ، ونبدأ نلاحق الاخطاء ونصلحها. وهناك 3 احتمالات فقط ، وسنناقشها جميعا ان شاء الله 🙂 الخطوة الاولى والاهم هي اضافة كلمة PtrSafe بعد كلمة Declare ، للنواتين 32بت و 64بت. أ. الدالة : Sleep نناديها بنواة 32بت هكذا : Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) وهنا مثال لعملها : 1.Sleep.32bits.accdb.zip عندنا الطرق التالية (وجميعها تعمل وصحيحة) لنبدا العمل لجعل المكتبة تعمل على النواتين 32بت و64بت (وستكون طريقة عملنا بأحد هذه الطرق لجميع المكتبات) : نلاحظ ان الفرق بين كود 32بت (اعلاه) ، واول كود 64بت (ادناه) هو اضافة كلمة PtrSafe بعد كلمة Declare ، والتي يقبلها نظام 32بت كذلك ، وفي الطرق الثلاثة التالية ، نستخدم نفس الكود رقم 1 ، ولكننا نغلفه بالامر IF# ، ولهذا المثال ، سوف استخدم الطريقة رقم 3 : '1 'Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '2 '#If VBA7 Then ' Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#Else ' Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#End If '3 #If VBA7 And Win64 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) #Else Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) #End If '4 '#If Win64 Then ' Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#Else ' Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#End If . ولكن ، لما نفتح الكود في الاكسس 64بت ، نلاحظ انه جعل كود 32بت باللون الاحمر : . على الرغم من البرنامج عمل لنا هذا السطر باللون الاحمر ، إلا ان الكود يعمل بطريقة صحيحة ، فلا تهتم به ، وبعد كل خطوة نعملها ، يجب ان نعمل Compile : حتى نعرف الخطأ التالي ، ونعدل عليه 🙂 ولما ما نحصل على خطأ ، فهنا نبدأ بتجربة البرنامج (على والاكسس 64بت ، والاكسس 32بت) ، حتى نتأكد بأنه يعمل بالطريقة الصحيحة ، والحمدلله ، هذه الدالة اصبحت جاهزة للعمل بالنواتين بهذا التغيير ، وتم تجربة الملف المرفق على النواتين🙂 وهذه النسخة بعد تحديثها للعمل على النواتين 32بت و64بت : 1.Sleep.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ ب. الدوال: GetSystemDirectory ، GetWindowsDirectory ، GetTempDir نواة 32بت : Private Declare Function apiGetSystemDirectory& Lib "kernel32" _ Alias "GetSystemDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare Function apiGetWindowsDirectory& Lib "kernel32" _ Alias "GetWindowsDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare Function apiGetTempDir Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long والبرنامج : 2.System_Directories.32bits.accdb.zip 64بت، خطوات التعديل ، بإضافة PtrSafe فقط: Private Declare PtrSafe Function apiGetSystemDirectory& Lib "kernel32" _ Alias "GetSystemDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare PtrSafe Function apiGetWindowsDirectory& Lib "kernel32" _ Alias "GetWindowsDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare PtrSafe Function apiGetTempDir Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long وعمل البرنامج بشكل صحيح للنواتين : 2.System_Directories.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ ج. الدالة: EnumFontFamilies عرض الخطوط fornts في مربع تحرير وسرد في الاكسس - قسم الأكسيس Access - أوفيسنا (officena.net) لأخونا @kanory 🙂 32بت : Private Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function GetFocus Lib "user32" () As Long والبرنامج: 4.Kan_Fonts.32bits.accdb.zip 64بت، خطوات التعديل ، بإضافة PtrSafe فقط: Private Declare PtrSafe Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare PtrSafe Function GetFocus Lib "user32" () As Long - لما نعمل Compile نحصل على الخطأ في السطر التالي: . اذن الخطأ في المتغير الثالث من الدالة EnumFontFamilies ، والذي نوعه Long ، فيجب تغييره في الدالة الى LongPtr ، الخطوة الثانية تغيير النوع Long الى LongPtr في الدالة وطبعا اذا عملنا التغيير على السطر اعلاه، فالنواة 32بت ستعطيك خطأ هنا ، لذا يجب تغليف الدالة بالامر IF# ، هكذا : . وعند عمل Compile مرة اخرى ، لا نحصل على خطأ ، والبرنامج يعمل بطريقة صحيحة ، البرنامج يعمل بطريقة صحيحة : 4.Kan_Fonts.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ د. دعوة لتجربة الاصدار الثالث من برنامج القران الكريم - صفحه 2 - قسم الأكسيس Access - أوفيسنا (officena.net) برنامج الذكر الحكيم لأخونا @ابا جودى 🙂 برنامج 32بت: 5.الذكر الحكيم V. 3.0.2.32bits.mdb.zip وقبل تشغيله على 64بت ، نضيف الامر PtrSafe الى جميع الدوال ، سواء لنواة 32بت او 64بت (ومنها تم عمله) ، ومنهم : Private Declare Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer الى Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer والنتيجة تمام : 5.الذكر الحكيم V. 3.0.2.64bits.mdb.zip ------------------------------------------------------------------------------------------------------ هـ. عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 3 - قسم الأكسيس Access - أوفيسنا (officena.net) مع ان الوحدة النمطية Shell_n_Wait تم اخذها من هذا الموقع : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas والتي تم عملها للنواتين 32بت و64بت ، ولكن لايزال البرنامج يعطي اخطاء في بيئة 64بت ، فنفتحة في برنامج 64بت ، نضيف الامر PtrSafe الى جميع الدوال ، ونعمل Compile ، وجدنا خطأ ، ونلاحظ اننا ننادي الدالة MoveWindow والتي تعطي قيمتها الى المتغير retval : . والآن لنرى الدالة نفسها ، ولكن الدالة جاهزة من الاصل للنواة 64بت ، ولا تحتاج الى تعديل : . وبعد التمعن ، نرى ان الخطأ موجود في نوع المتغير retval ، حيث اننا اعلنا انه Long ، بينما في بيئة 64بت نلاحظ انه LongPtr ، فالحل يكون ، اما ان نعمل IF# في الكود الاول ، واما ان نوقف الاعلان في الكود الاول ، ونضيفه في الكود الثاني ، كل حسب نوعه ، وانا سأعمل المقترح الثاني: #If VBA7 Then Declare PtrSafe Function MoveWindow Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr, _ ByVal nHeight As LongPtr, ByVal bRepaint As LongPtr) As LongPtr Public retval As LongPtr #Else Declare Function MoveWindow Lib "User32.dll" (ByVal HWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal bRepaint As Long) As Long Public retval As Long #End If . نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي: . والدوال: . فالحل هو ان نغلف الدوال بالامر IF# ، ونجعل بيئة 64بت ان يكون LongPtr ، فقط للمتغير الاول لهذه الدالة ، . نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي: . والتعديل : . وهكذا الى بقية الاخطاء المشابهة ..... الخطأ التالي ، والغير عن الاخطاء اعلاه : . بالبحث ، لا نجد له دالة ، وانما نجد انه تم الاعلان عنه: . فيجب حذفه من هذا الاعلان ، وإضافته الى التغليف IF# ، فيكون اعلاه للبيئة 32بت ، واما للنواة 64بت فيكون LongPtr ، وبعد جميع التعديلات ، تكون النسخة تعمل على النواتين ، كما في المرفق: عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 4 + عمل نسخ احتياطية - قسم الأكسيس Access - أوفيسنا (officena.net) ------------------------------------------------------------------------------------------------------ واخيرا: و. دالة فتح نافذة اختيار/حفظ الملف: GetOpenFileName و GetSaveFileName والتعديل على هذه الدوال لا يعتمد على التغليف IF# ، وجعل الاعلان عن المتغير فيه ، ونما نحتاج الى تغيير Len الى LenB ، ونحتاج الى تعديل هذه الجزئية كذلك: . وهذا الملف للنواتين: 9.Allow_ByPass_Key.64bits.mdb.zip بهذه الطرق ، نستطيع ان نحول برامجنا لتعمل على نواتي اكسس 32بت و64بت 🙂 الموضوع فني بحت ، وتحتاج ان يكون عندك نواتي اكسس ، حتى تعدل على النواتين ، ثم تجربهم الاثنين 🙂 ------------------------------------------------------ وهناك طريقة ثانية ، اعتقد بأنها اسهل واستعملها دائما : جعفر 1.Sleep.64bits.accdb.zip 1.Sleep.32bits.accdb.zip Win32API_PtrSafe.zip

بداية شكرا لاهتمام حضرتك بالرد جرب تطبيق الكود علي الأسماء الموجودة في الملف المرفق وأنظر للنتيجة تجد رغم تشابه الأسماء إلا أن الخلية التي تنتهي بمسافة لم يتم حذفها وبذلك لا يراها الاكسيل متطابقة عند البحث عن المكررات حذف المسافات الزائدة.rar