كل الانشطه

التجربة الثانية : Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long ' Get the current state of the NumLock key Function GetNumLockKey() As Boolean GetNumLockKey = GetKeyState(vbKeyNumlock) End Function والناتج : '=================================================== ' API Code Converter for Dual Compatibility (32-bit & 64-bit) ' Developed By Foksh (Officena.Net) ' Generated on: 2025-05-29 08:55:17 ' Tool version: v1.2 '=================================================== #If VBA7 And Win64 Then ' 64-bit declarations Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #Else ' 32-bit declarations Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As _ Long #End If أولا : ما أضاف الدالة GetNumLockKey() تماما ..! ثانيا : لا حظت أنه بعد نسخ الناتج يمسحه من النموذج (الأفضل أن يضل مكانه ) في ظل وجود الزر (مسح الحقول) :

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

ماشاء الله عليك باش مهندس @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

وهو كذلك شكرا استاذ 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

وعليكم السلام ورحمة الله وبركاته جرب هدا Option Explicit Const Salaries As Double = 250000 Sub SplitTables() Dim WS As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet Dim lastRow As Long, i As Long, Tbl1 As Long, Tbl2 As Long, tbl3 As Long, arr Dim sum1 As Double, sum2 As Double, sum3 As Double, OnRng As Range, CrWS As Variant Dim tmp() As Double, n() As Long, ky() As Boolean, j() As Boolean, k() As Boolean SetApp False Set WS = ThisWorkbook.sheets("Net") TmpWS "تقسيم1": TmpWS "تقسيم2": TmpWS "تقسيم3" Set Sh1 = ThisWorkbook.sheets("تقسيم1") Set Sh2 = ThisWorkbook.sheets("تقسيم2") Set Sh3 = ThisWorkbook.sheets("تقسيم3") CrWS = Array(Sh1, Sh2, Sh3) For Each arr In CrWS arr.Columns("A:H").Clear arr.DisplayRightToLeft = True Next lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row ReDim tmp(2 To lastRow), n(2 To lastRow), ky(2 To lastRow) ReDim j(2 To lastRow), k(2 To lastRow) For i = 2 To lastRow tmp(i) = WS.Cells(i, "D").Value n(i) = i Next i Set OnRng = WS.[A1:H1] OnRng.Copy Sh1.[A1]: OnRng.Copy Sh2.[A1]: OnRng.Copy Sh3.[A1] Tbl1 = 2: Tbl2 = 2: tbl3 = 2: sum1 = 0: sum2 = 0: sum3 = 0 For i = 2 To lastRow If tmp(i) > Salaries Then WS.Rows(n(i)).Copy Sh3.Rows(tbl3) tbl3 = tbl3 + 1 ky(i) = True sum3 = sum3 + tmp(i) End If Next i If Not WsTotal(tmp, ky, Salaries, j) Then Call WsTotal(tmp, ky, Salaries, j) For i = 2 To lastRow: If j(i) Then ky(i) = True Next i If Not WsTotal(tmp, ky, Salaries, k) Then Call WsTotal(tmp, ky, Salaries, k) For i = 2 To lastRow If j(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh1.Range("A" & Tbl1) sum1 = sum1 + tmp(i) Tbl1 = Tbl1 + 1 ElseIf k(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh2.Range("A" & Tbl2) sum2 = sum2 + tmp(i) Tbl2 = Tbl2 + 1 ElseIf Not ky(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh3.Range("A" & tbl3) sum3 = sum3 + tmp(i) tbl3 = tbl3 + 1 End If Next i AddTotal Sh1, Tbl1, sum1: AddTotal Sh2, Tbl2, sum2: AddTotal Sh3, tbl3, sum3 ColArr CrWS WS.Activate MsgBox "تم تقسيم جدول الرواتب بنجاح", vbInformation SetApp True End Sub Private Sub AddTotal(sht As Worksheet, ling As Long, total As Double) sht.Cells(ling, "C").Value = "الإجمالي" sht.Cells(ling, "D").Value = Format(total, "0.00") With sht.Range(sht.Cells(ling, "C"), sht.Cells(ling, "D")) .Font.Bold = True: .Interior.Color = RGB(220, 230, 241) End With End Sub Private Sub ColArr(sheets As Variant) Dim sht As Variant For Each sht In sheets sht.Columns("A:H").AutoFit Next sht End Sub Private Sub TmpWS(sheetName As String) Dim WS As Worksheet On Error Resume Next Set WS = ThisWorkbook.sheets(sheetName) On Error GoTo 0 If WS Is Nothing Then Set WS = ThisWorkbook.sheets.Add(After:=ThisWorkbook.sheets(ThisWorkbook.sheets.Count)) WS.Name = sheetName End If End Sub حافظة إلكترونية مصارف التجاري052025 V-2.xls

تفضل أخي الكريم مع العلم أنه (كما أبلغتك سابق) لا توجد خلية واحدة بها رقم 250000. لذلك عند تجريب الملف تأكد من وضع الرقم المطلوب في أي خلية. حافظة إلكترونية مصارف التجاري052025.xlsm

💥 الإداة بواجهتين ( عربي - انجليزي ) والرسائل والردود حسب كل لغة Code Converter x64.zip Code Converter x32.zip طبعاً ، أتمنى ممن يرغب بتجربة الأداة بأول إصدار لها ، أن يزودني بالنتيجة التي قام بها على الكود ، بحيث :- ينشر في رده الكود الأصل ( الذي قام بتجربته ) ، والكود الناتج ( بعد تحويله من الأداة ) لتعم الفائدة ولمعرفة الأخطاء التي قد تحدث ( ولا شك أن الأداة تحتوي أخطاء كثيرة ، ولكن لإجراءاتكم بالإفادة ) . إن كان يملك الكود الصحيح والمنطقي ( الذي يعمل على النواتين ) ، فشاكراً له تزويدنا به للمقارنة . Code Converter x32.zip Code Converter x64.zip

نعم فهمتك على ما أعتقد ، انت تريد زر الطباعة أن يعمل على أي تقرير تم فتحه ( في الوقت الحالي ) ، صحيح ؟؟ سنحاول الإستفادة من المتغير العام :- Public namerpts As String بحيث نمرر لزر التصدير اسم التقرير الحالي بشكل ديناميكي . وعليه فيصبح الكود لزر التصدير كالتالي :- Dim stDocName As String, xx As String, strPathAndfile As String Dim reportDate As Variant stDocName = namerpts On Error Resume Next reportDate = [Reports]![namerpts]![DATE] On Error GoTo 0 If IsNull(reportDate) Or Not IsDate(reportDate) Then xx = stDocName & "-" & Format(DATE, "dd_mm_yyyy") Else xx = stDocName & "-" & Format(reportDate, "dd_mm_yyyy") End If strPathAndfile = CurrentProject.Path & "\" DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathAndfile & xx & ".pdf", True لم أقم بتصعيد الموضوع بكود طويل ، واقتصرت على الكود السابق لسهولته وفهمه بسهولة ,, تفضل الملف بعد التعديل ، جربه وأخبرني بالنتيجة . ملاحظة .. يفضل أن يكون اسم الحقل الخاص بالتاريخ متساوي في كل التقارير ، لتلافي تطوير الكود . حفظ بصغة PDF.zip

أخي الفاضل الأستاذ / @عبدالله بشير عبدالله السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا؛ قمتم بعمل المطلوب على أكمل وجه. لَوْ كَانَ يَسْتَغْنِي عَنِ الشُّكْرِ .. لِـــعِزَّةِ مُلْـــكٍ أَوْ عُلُــــوِّ مَكَانِ لَمَا أَمَرَ اللَّهُ الْعِبَادَ بِشُكْرِهِ .. فَقَالَ اشْكُرُوا لِي أَيُّهَا الثَّقَلَانِ دُمتم ودام إبداعكم وعطائكم المتميز ودام تميزكم.. وحفظكم الله بحفظه ورعاكم بعنايته؛ وجزاكم الله عنا خير الجزاء. لي طلب أخير: 1) بالنسبة للقائمة المنسدلة المرنة (المطاطية) في الخلية (B9) هل يمكن إضافة خلية واحدة فقط فارغة لها بحيث لا تحتوي على أية بيانات؟ 2) بالنسبة للخلية (B5) التي تختص بالأسماء؛ كنت قد طلبت سابقا حذف القائمة المنسدلة منها عن (جهل وعدم علم)؛ ولما علمت أنه يمكن البحث في قائمة الأسماء المنسدلة (المرنة) وبالتالي يمكن اختيار الاسم منها بدل كتابته كاملا مما يسهل ويختصر الوقت؛ لذا أرغب في إضافتها مرة ثانية بحيث لو تم إضافة او حذف اسم في كلا من شيتي: (DATA) أو (معاشات) يتم ذلك بطريقة ديناميكية تماما مثل القائمة المنسدلة في (J5) على وجه التحديد. أخي الفاضل الأستاذ / @محمد هشام. السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا؛ قمتم بعمل المطلوب على أكمل وجه. لَوْ كَانَ يَسْتَغْنِي عَنِ الشُّكْرِ .. لِـــعِزَّةِ مُلْـــكٍ أَوْ عُلُــــوِّ مَكَانِ لَمَا أَمَرَ اللَّهُ الْعِبَادَ بِشُكْرِهِ .. فَقَالَ اشْكُرُوا لِي أَيُّهَا الثَّقَلَانِ دُمتم ودام إبداعكم وعطائكم المتميز ودام تميزكم.. وحفظكم الله بحفظه ورعاكم بعنايته؛ وجزاكم الله عنا خير الجزاء. لي طلب أخير: هل لي أن أطمع في كرمكم بإضافة (CommandButton) بجوار: جلب النتائج؛ وإلغاء؛ وخروج؛ يختص بمسح النتائج التي تم جلبها؛ وأنا لكم من الشاكرين.

شكرا استاذ تم تعديل نوعية الخط وكان الحل تمام والان استاذ كيف يتم التعديل على الكود المعدل من طرف حضرتك علما انه لديا تقريرين اذا فتحت بواسطة الفورم FrmCCp التقرير rptTransfer_BEA_CCP والفورم الثاني FrmVerment و التقرير rptDiscountDetail0 علما ان شريط الطباعةPrin واحد لهما في زوج أتمنى انك فهمت مقصدي

حفظ بصغة PDF.zip

ممكن تعطيني فكرة على ذلك استاذ

افتح هذا الملف من جهازي ، بعد ضبط وتغيير حجم الخط ومساحة مربع النص 0 العرض ) ، ثم تصدير التقرير .. علماً أن الخط Sultan Medium ليس موجوداً على جهازي . rptTransfer_BEA_Ccp-19_01_2025.pdf

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

اخي الكريم ، المشكلة قد تكون بحجم الخط ، حاول إما تكبير مربع النص ، أو تصغير حجم الخط !!!

شكرا استاذ على التصحيح اما بخصوص تسمية المربع التاريخ Date اعرف أنه يسبب مشكلة في الاصل اسمه TxtMonth ولكن استاذ عند التحويل الى صيغة PDF وقعت مشكلة في التاريخ والمبلغ مانعرف السبب نوعية الخط ام ماذا علما اني استخدم خط Sultan Medium