كل الانشطه

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

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

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

وعليكم السلام ورحمة الله وبركاته ،، أتمنى أن تكون الصورة قد وضحت لي وتم فهمها بالشكل الصحيح 😅 .. انظر للصورة الأولى :- والنتيجة للصورة الثانية :- هل تلبي المطلوب بالشكل الصحيح ؟ خبرتي في اكسل قليلة جداً مقارنة مع الأساتذة ( دون استثناء ) في هذا الصرح الكبير . التنفيذ تم باستخدام الماكرو التالي :- Sub FillAccountNum() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Dim accountVal As String Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row For i = 2 To lastRow If InStr(1, ws.Cells(i, "K").Value, "متبقي تعاقد مشروع قسط") > 0 Then For j = i + 1 To lastRow If Trim(ws.Cells(j, "A").Value) Like "Account*" Then accountVal = ws.Cells(j, "A").Value ws.Cells(i, "A").Value = accountVal Exit For End If Next j End If Next i End Sub المرفق بعد التنفيذ :- EXPORT.XLSX وفيما يلي ، توضيح لتفعيل وضع المطور واختيار الماكرو للشيت الحالي .. جرب وأخبرني بالنتيجة ، للمتابعة .

شكرا لك و لك كل التقدير والاحترام

السلام عليكم ورحمه الله وبركاته - أرجو طباعة الشهادات PDF 2022شيت مدرستى شهادات الأول والثانى- الصف الأول.xls

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

جميل جداً .. ستتم المتابعة

السلام عليكم كل عام وحضراتكم بالف خير طلب من اخواننا الخبراء احتاج كود مختصر وسهل فاانا لست خبير يتم وضعه في ملف الاكسل يجعل اكواد الملف تعمل سواء كانت البيئة ٣٢ بايت او ٦٤ بايت وجزاكم الله خير وكل عام وانتم بخير

سلمت الأنامل ياصاحب اللمسات الذهبية 😊 بعد التعديل : المشكل الأول : المشكل الثاني (بعد إزالة الشرط السفلية يدويا) : وأعزوه إلى وجود دوال الAPI في الأسفل بدل وجودها في أعلى صفحة الموديول والله أعلم ، لأن المشكلة تختفي بعد رفعها في الأعلى

ولأجمل هو تشريفكم لنا بملاحظاتكم ومروركم العطر .. بارك الله فيكم ، وهي ما زالت في طور التحديث كلامك سليم ، وكانت من ضمن الاحتمالات التي مررت بها ، ولكن لله الحمد تم إضافة التعديل وأصبحت النتيجة لأول تجربة لك = '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 10:34:09 ' Tool version: v1.3 '=================================================== #If VBA7 And Win64 Then ' 64-bit declarations Public Declare PtrSafe Function CopyFile Lib "kernel32" Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long #Else ' 32-bit declarations Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA"(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long)As Long #End If لمتابعتكم إن كانت النتيجة صحيحة .. جزاااكم الله خيراً تم الاطلاع واكتساب الفائدة . والتجربة الثانية ، بعد التحديثات الحالية كانت نتيجتها = '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 10:37:15 ' Tool version: v1.3 '=================================================== Private Const KEYEVENTF_KEYUP = &H2 ' Get the current state of the NumLock key Function GetNumLockKey() As Boolean GetNumLockKey = GetKeyState(vbKeyNumlock) End Function Sub SetNumLockKey(ByVal newState As Boolean) ' if the current state must be changed If CBool(GetKeyState(vbKeyNumlock)) <> newState Then ' programmatically press and release the NumLock key keybd_event vbKeyNumlock, 0, 0, 0 keybd_event vbKeyNumlock, 0, KEYEVENTF_KEYUP, 0 End If End Sub #If VBA7 And Win64 Then ' 64-bit declarations Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long #Else ' 32-bit declarations Private Declare Sub keybd_event Lib "user32"(ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32"(ByVal nVirtKey As Long)As _ Long #End If هل توافق المطلوب أم لا ؟؟ هذه النقطة كنت قد سهوت عنها من كثرة التجارب ، وكنت اعتمد القص بدلاً من النسخ 😅 . سيتم اعادة الكود للنسخ بدلاً من القص .

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

التجربة الثانية : Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long Private Const KEYEVENTF_KEYUP = &H2 ' Get the current state of the NumLock key Function GetNumLockKey() As Boolean GetNumLockKey = GetKeyState(vbKeyNumlock) End Function Sub SetNumLockKey(ByVal newState As Boolean) ' if the current state must be changed If CBool(GetKeyState(vbKeyNumlock)) <> newState Then ' programmatically press and release the NumLock key keybd_event vbKeyNumlock, 0, 0, 0 keybd_event vbKeyNumlock, 0, KEYEVENTF_KEYUP, 0 End If End Sub والناتج : '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 09:11:57 ' Tool version: v1.2 '=================================================== Private Const KEYEVENTF_KEYUP = &H2 #If VBA7 And Win64 Then ' 64-bit declarations Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #Else ' 32-bit declarations Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #End If أولا : ما أضاف الدوال GetNumLockKey و SetNumLockKey في الناتج تماما ..! ثانيا : لا حظت أنه بعد نسخ الناتج يمسحه من النموذج (الأفضل أن يضل مكانه ) في ظل وجود الزر (مسح الحقول) :

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

ماشاء الله عليك باش مهندس @Foksh 🙂🌹 اللي أجمل من التنفيذ هو الفكرة نفسها .. فتح الله عليك 😊 مبدأيا وأول تجربة للأداة .. شوف أنت واحكم بنفسك 😁: ' --------------------------<< المصدر >>---------------------- Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long ' --------------------------<< النــاتج >>---------------------- '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 08:45:50 ' Tool version: v1.2 '=================================================== #If VBA7 And Win64 Then ' 64-bit declarations Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long #Else ' 32-bit declarations Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long #End If حاسس أنه ماشي تغير في دالة ال API أو فيه شي ناقص (PetrSafe) مثلا ؟؟!! 🤔 وللفائدة هذي مكتبات كبيرة لأكواد ال API ممكن تستفيد منها : https://binaryworld.net/Main/Api.aspx?L=3 http://vbnet.mvps.org/

وهو كذلك شكرا استاذ Foksh

مشاركة مع اخي @Foksh تفضل استاذ @2saad طلبك حسب مافهمت .ووافني بالرد . Data21-1.rar

📌 مقدمة عن الأداة :- أقدم لكم أداة متقدمة لتحويل أكواد API في آكسيس من الإصدارات القديمة والحديثة ، لتكون متوافقة مع أنظمة 64-bit مع الحفاظ على التوافق مع أنظمة 32-bit . هذه الأداة تم تطويرها خصيصاً لمطوري ومبرمجي قواعد البيانات الذين يعانون من مشاكل التوافق عند الترقية إلى إصدارات أوفيس 64-bit . 🎯 المشكلة التي تحلها الأداة :- مع إصدار أوفيس 64-bit ، تغيرت بنية المؤشرات والأنواع الخاصة بمناولة النوافذ (Handles) من Long (32-bit) إلى LongPtr (64-bit) . هذا التغيير جعل معظم إعلانات API القديمة غير صالحة للعمل على الإصدارات الجديدة ، مما يتطلب تعديلها يدوياً لها . ما الجديد في التحديث الجديد ؟ ميزات الأداة الرئيسية والمحدثة :- تحويل تلقائي للإعلانات :- تقوم بتحويل إعلانات API من صيغة 32-bit إلى صيغة مزدوجة ( 32 و 64 ) متوافقة مع كلا النظامين . دعم أنواع البيانات الخاصة :- تدعم الأنواع المعرفة من المستخدم (User-Defined Types) مثل RECT , POINTAPI وغيرها . تحليل ذكي للكود :- تتعرف على المتغيرات التي تحتاج تحويلاً وتعدلها تلقائياً . حفظ التوافق مع الإصدارات القديمة :- تحافظ على عمل الكود على أنظمة 32-bit أثناء إضافة دعم 64-bit . واجهة سهلة الاستخدام :- توفر واجهة بسيطة لتحويل الأكواد بنقرة واحدة . كيف تعمل الأداة ؟ تعتمد الأداة على عدة خطوات ذكية لتحليل الكود وإجراء التحويل :- 1. تحليل الإعلانات :- تفحص كل إعلانات API لتحديد ما إذا كانت تحتاج إلى تعديل أم لا !!! 2. تحديد أنواع البيانات :- تتعرف على المتغيرات من نوع Long التي تمثل مؤشرات أو مقابض (Handles) بشكل تلقائي وذكي . 3. إنشاء كود مشروط :- تولد كوداً يستخدم التعليمة الشرطية #If VBA7 And Win64 Then للتفريق بين النظامين . 4. الحفاظ على الهيكل الأصلي :- تحافظ على التعليقات والتنسيق الأصلي للكود قدر الإمكان . ( باللغة الإنجليزية حالياً) . أنواع API التي تتعامل معها الأداة :- تتعامل الأداة مع مجموعة واسعة من إعلانات API ، بما في ذلك :- إدارة النوافذ (User32.dll) FindWindow, GetWindow, SetWindowPos SendMessage, PostMessage GetWindowRect, GetWindowText إدارة الذاكرة والعمليات (Kernel32.dll) VirtualAlloc, VirtualFree OpenProcess, CreateProcess GetModuleHandle, GetProcAddress إدارة التسجيل (Advapi32.dll) RegOpenKey, RegCreateKey RegQueryValue, RegSetValue إدارة واجهة المستخدم CreateDC, CreateCompatibleDC SelectObject, DeleteObject الخصائص الفنية للأداة :- الدقة في التحويل :- تتعرف الأداة على السياقات المختلفة للمتغيرات من نوع Long لتحديد ما إذا كانت تمثل مقابض تحتاج للتحويل . دعم اللغات :- تدعم الواجهة اللغتين العربية والإنجليزية . التحقق من الأخطاء :- تحتوي على آلية للتحقق من الأخطاء المحتملة أثناء التحويل . التعامل مع الاستثناءات :- تتعرف على الدوال التي لا تحتاج للتحويل مثل GetVersion وGetTickCount .

ConvertDates.rar

وعليكم السلام ورحمة الله وبركاته .. احذف بيانات الجدول ( Tbl_degree_Detail ) أولاً ، ثم عدل الاستعلام في زر الاعداد الى التالي :- DoCmd.RunSQL "INSERT INTO Tbl_degree_Detail ( draseid, draseDate, Stu_card, Elsaf, madaNum, madaName, ramz, ramz2, Stugalos ) " & vbCrLf & _ "SELECT [forms]![frm_DraseIN]![drase] AS drs, [forms]![frm_DraseIN]![Text1] AS drsdt, Tbl_student.Stucard, Tbl_student.alsaf_Id, Tbl_materil.materil_id, Tbl_materil.materil, Tbl_materil_Detail.rmz, Tbl_materil_Detail.rmz2, Tbl_student.Stugalos " & vbCrLf & _ "FROM Tbl_materil INNER JOIN ((Tbl_saf INNER JOIN Tbl_student ON Tbl_saf.saf_id = Tbl_student.alsaf_Id) INNER JOIN Tbl_materil_Detail ON Tbl_saf.saf_id = Tbl_materil_Detail.saf_No) ON Tbl_materil.materil_id = Tbl_materil_Detail.mat_NO;" طبعاً وللتأكيد بإخبارك بضرورة إضافة نفس الحقل من نفس النوع في الحدول المستهدف ، واعتقدت بعدم ذكرها أنك تعلم ذلك جرب وأخبرني بالنتيجة .. 😅

اخواني الأعزاء اعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته في الملف المرفق كيف اضيف حقل ( Stugalos ) الموجود في جدول ( Tbl_student ) الي جدول ( Tbl_degree_Detail ) وذلك عن طريق الضغط علي زر ( إعداد ) الموجود في النموذج المسمي ( frm_DraseIN ) Data21.zip

ارجو المساعدة للضرورة

للرفع

تفضل استاذ @الميزار طلبك بعد التعديل . ووافني بالرد . Miraz-1.rar

Private Sub CommandButton1_Click() SetApp False Dim lastRow As Long:lastRow = Sh1.Cells(Sh1.Rows.Count, "A").End(xlUp).Row If lastRow >= 5 Then With Sh1.Range("A5:M" & lastRow) .ClearContents .Borders.LineStyle = xlNone End With End If UpdateCounter SetApp True End Sub توحيد البحث في شيت واحد v3.xlsb