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

السلام عليكم ورحمة الله وبركاته ، أتشرف بتلبية دعوتكم للمشاركة أخي @سلمان الشهراني . واسمحوا لي بالبدء بأول تفاعل بعد معلمي الفاضل @ابوخليل ، وبانتظار أساتذتي للدعم وتصحيح مفاهيمي إن كانت خاطئة . بداية أعتقد وجوب وجود المكتبة Microsoft Script Runtime ، هذا الكود الذي خلصت به ولا أعلم إن كانت النتيجة صحيحة كما تريدون أم لا ، إلا أنني قمت بالتجربة على الموقعين في الفيديو وكانت النتيجة مرضية ومطابقة ( الموقع الأول ، الموقع الثاني ) . فيما يلي ، الكود الأول لتحويل النص إلى SHA256 Hex Function TextToBase64(ByVal text As String) As String Dim sha As Object Dim utf8Bytes() As Byte Dim hash() As Byte Dim i As Integer Dim hashHex As String Set sha = CreateObject("System.Security.Cryptography.SHA256Managed") utf8Bytes = StrConv(text, vbFromUnicode) hash = sha.ComputeHash_2(utf8Bytes) hashHex = "" For i = LBound(hash) To UBound(hash) hashHex = hashHex & Right("0" & Hex(hash(i)), 2) Next i TextToBase64 = Base64Encode(hashHex) Set sha = Nothing End Function Function Base64Encode(ByVal strData As String) As String Dim objXML As Object Set objXML = CreateObject("MSXML2.DOMDocument").createElement("b64") objXML.DataType = "bin.base64" objXML.nodeTypedValue = strData Base64Encode = objXML.text Set objXML = Nothing End Function والنتيجة يتكون في مربع النص ( الهدف الأول ) عن طريق زر الإستدعاء كما يلي :- Private Sub btnComputeHash_Click() If IsNull(Me.txtInput) Then MsgBox "يرجى إدخال قيمة ليتم تشفيرها", , "" Me.txtInput.SetFocus Exit Sub End If Dim myText As String myText = Me.txtInput Dim base64Hash As String base64Hash = TextToBase64(myText) Me.txtHashOutput = base64Hash End Sub ثم باستخدام هذا الكود وبعد عدة تجارب يتم تحويل الـ Hex إلى Base64 : Function HexToBase64(ByVal hexString As String) As String Dim bytes() As Byte Dim objXML As Object bytes = HexStringToBytes(hexString) Set objXML = CreateObject("MSXML2.DOMDocument").createElement("b64") objXML.DataType = "bin.base64" objXML.nodeTypedValue = bytes HexToBase64 = objXML.text Set objXML = Nothing End Function Function HexStringToBytes(ByVal hexString As String) As Byte() Dim bytes() As Byte Dim i As Integer ReDim bytes(Len(hexString) \ 2 - 1) For i = 1 To Len(hexString) Step 2 bytes((i + 1) \ 2 - 1) = Val("&H" & Mid(hexString, i, 2)) Next i HexStringToBytes = bytes End Function ويتم الاستدعاء في الزر كالآتي :- Private Sub Btn_Base64_Click() If IsNull(Me.txtHashOutput) Then MsgBox "لم يتم حساب قيمة Hex بعد.", , "" Exit Sub End If Dim base64Value As String base64Value = HexToBase64(Me.txtHashOutput) Me.Txt_Base64 = base64Value End Sub وفي النهاية أترك التجربة للحكم والتعديل . Hash Con.accdb

جرب هدا test.xlsx

هناك كود في التقرير لرسم الخطوط ..... مثل هذا

انا اعمل على اصدار 2016 نواة 64 ، ويعمل بكفاءة 20240520_180203.zip

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

بالنسبة لي : أنا مفعل الضغط والإصلاح التلقائي للقاعدة عند الإغلاق .. وما واجهت أي مشكلة معها ، بالعكس أحس أن أداء البرنامج يتحسن ، والملف بنفسه يتخلص من البيانات المؤقتة والأخطاء 🙂

تفضل استاذ @2saad محاولتي حسب مافهمت . وأعتذر على التأخير . فقط طالع التقرير .ووافني بالرد . انشاء اطار للتقرير.rar

السلام عليكم ورحمه الله وبركاته تفضل اخي filter-function-excel.xlsb

أوفيس 365 32بت .. يعمل بشكل صحيح

اوفيس 10 .. 32 بت يعمل

اوفيس 16 32 بت .... يعمل الملف

@ابوخليل @Foksh بارك الله فيكم وشاكر لتفاعلكم والله يعطيك الف عافيه نعم تم تجربة المثال على اوفيس 32بت و 64 بت ويعمل بكفاءه نتمنى من الاخوه التجربه على 32 بت لكونه الاهم وننتظر المشاركة من باقي الخبراء والاخوان في هذا الموضوع

نعم ، تستطيع ، افتح موضوع جديد وإن شاء الله تجد الحل المناسب

قم بتفعيل الماكرو يا اخي بالضغط على تمكين التحرير

الله ينور عليك حضرتك استاذ ورئيس قسم جزاك الله خير

الله يعطيك العافيه اخي فعلا يبدو ان المشكله عدنا بنسخة الاوفيس نظام 32 بت

استاذ @ناقل كل الشكر والتقدير بارك الله فيك كل شيء تمام

مشاركة مع أساتذتى فى حدث عند الطباعة Private Sub Report_Page() Me.DrawWidth = 10 Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), , B Me.DrawWidth = 20 Me.Line (20, 20)-(Me.ScaleWidth - 20, Me.ScaleHeight - 20), , B End Sub

تفضل يا صديقي ، استخدم هذا الكود في التقرير عند الفتح Me.Text121 = Year(Date) عدم تجاوز التسلسل.accdb هكذا سيتم تغيير السنة حسب التاريخ

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

جرب كده ..... ‏‏جديد - نسخة.accdb

يسعدنا حصولك على النتيجة المطلوبة لاكن للفائدة فقط لا غير . من الممكن تبسيط الكود لاكن هناك احتمالات واردة ربما لم تقم بتجربتها مثلا كالبحث عن قيمة فريدة او رقم يتضمن قيمة عشرية الكود الخاص بي تم انشاءه لتطابق القيم ليس للبحث بالتشابه هدا لانك طلبت البحث بجميع الاعمدة عن قيمة معينة او ربما لم استوعب طلبك جيدا .لقد فكرت مسبقا في اقتراح استادنا الغالي @حسونة حسين لاكن للاسف يعطي اخطاء جرب ادخال قيمة غير مكررة او تاريخ غير مكرر والبحث عنها او البحث عن رقم مثلا 3.530 ستلاحظ انه تم اظهار رسالة عدم تواجده . او تكراره في عدة اعمدة رغم وجوده مرة واحدة فقط على الملف بالتوفيق.......... جديد (1).xlsm

تفضل استاذ @أبو منتظر محاولتي حسب مافهمت اليك الشرح والمرفق . ووافني بالرد DDTest2Form.rar

وعليكم السلام ورحمه الله وبركاته تفضل اخى جرب هذا التعديل Option Explicit Private Sub CommandButton1_Click() Dim Ws As Worksheet, CEl As Range, Sheets_name As Variant, Sh, Temp() Dim Str As String, i As Long, j As Long, Lr As Long Str = Me.TextBox1.Value Sheets_name = Array("عين غزال", "الجبيهة", "الجبيهة", "أربد", "الزرقاء") i = 0 For Each Sh In Sheets_name Set Ws = ThisWorkbook.Sheets(Sh) Lr = Ws.Cells(Ws.Rows.Count, 9).End(xlUp).Row For Each CEl In Ws.Range("A2:J" & Lr) If InStr(CEl.Value, Str) > 0 Then i = i + 1 ReDim Preserve Temp(1 To 12, 1 To i) For j = 1 To 10 Temp(j, i) = Ws.Cells(CEl.Row, j).Value Next j Temp(11, i) = Ws.Name Temp(12, i) = CEl.Address End If Next CEl Next Sh If i = 0 Then MsgBox "ما تحاول البحث عنه غير موجود في الاسواق ", vbInformation + vbSystemModal, "نظام البطاقات الائتمانية - Search " TextBox1.Text = "" Else Temp = Application.Transpose(Temp) With Me.ListBox1 .ColumnCount = 12 .ColumnWidths = "96,96,96,96,140,96,96,96,96,96,96,96" .Clear .List = Temp End With End If End Sub جديد.xlsm

أخي @Abdelaziz Osman ، لا تحتاج كود لهذه الوظيفة فآكسيس يوفرها لك من خلال أن تحدد مربع النص الذي تريده ، ثم من تبويب Format ، انزل لآخر خيار Try.accdb