كل الانشطه

تفضل استاذ @بلال بلال طلبك مع الشرح . ووافني بالرد . Yamen-QRCode.rar

تم تنقيح الكود لتسهيل التعديل عليه Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, DateRange As String, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target DateRange = Replace(.Address, "$", "") If DateRange <> "M1" Then 'تبديل عنوان خلية التاريخ عند الحاجة' Beep 'MsgBox Exit Sub End If If Not IsDate(Range(DateRange)) Then Beep 'MsgBox Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_06.xlsm

تم رفع إصدار محدث من الأداة حيث تم تحسين طريقة العرض حتى يسهل العمل مع جمل Sql بحيث أصبحت تظهر بشكل منسق كما بالصورة

هههههههه انا قلت يمكن بعدل شي أو يضيف شي داخل الملف للتمييز بينهم 😛 إن شاء الله حال وصولي لنسبة ترضي غرور أفكاري 😁 ، لن أبخل عليكم بها

غيرت الإسم فقط 😅 وصلت لنفس النتيجة أي أنه في الحالتين لم يتم إسترجاع الوحدات النمطية ولكن في المجمل فإن إسترجاع النماذج والتقارير شيئ ليس بالقليل وياريت تشاركنا بالطريقة

بعض ما عندكم يا أستاذنا الكبير .. أتمنى أن تكون قد غيرت به شيئاً مخفياً كي نميز بين المرفق السابق ، والتالي .. Mont_ProgressBar_NoPassword.zip بلا شك 👍 طبعاً المكتبات لا تعنيني نهائياً في فكرتي .. فأنا أقوم حالياً بجلب المكونات الى ملف ACCDB إصدارات حديثة = 2019 = نسخة الأوفيس التي لدي حالياً .. وبخصوص هذه النقطة ، جاري بناء مكتبة وخوارزمية كاملة ( مبنية على ملف VBA7.Dll ) تم كسر حمايته من إصدار أوفيس 2019

لو اجريت عملية بحث بسيطة كنت ستجد أكثر من موضوع خاص بـ QRCode وهذا أول موضوع ظهر لي

على فكرة إصدارات الأوفيس كانت تتغير كل سنة فمثلا 2003 كان الإصدار Office 11 وفي 2007 أصبح Office 12 وهكذا وحتى 2013 ولكن إبتداء من 2016 كله أصبح Office 16 وهذا مانجده في المراجع كما بالصورة

بصراحة أعتبر هذه النتيجة بحد ذاتها إنجاز المثال السابق كنت قد وضعت كلمة سر للتعليمات البرمجية ولكن كيف ستكون النتيجة إذا ماجعلناها بدون تأمين؟ هذا نفس الملف ولكن بدون تأمين للتعليمات البرمجية Mont_ProgressBar.rar

أستاذ @منتصر الانسي ، هذه تجربتي على استخراج النماذج بتصاميمها حرفياً ( دون أكواد VBA ) حالياً في المرحلة الأولى .. Montaser.accdb

السلام عليكم اريد اضافة كيو بار كود المربع في التقرير

لكم مني كل الاحترام والتقدير 👍

شكرا جزيلا على الزياده في الحل وهذا هو الفضل وزيادة بارك الله فيكم وجزاكم خيرا

حل آخر بالكود: Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target If Not (Target.Row = 1 And Target.Column = 13) Then Exit Sub yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Application.EnableEvents = False Application.ScreenUpdating = False Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_05.xlsm

مطلوب قاعدة بيانات آكسيس 2003 مقفلة MDE . ولا يهمني الداتا التي فيها أبداً ولا حتى ان تكون لمشروع كامل إذا سمحتم 🤗

مشاركة مع استاذ @منتصر الانسي تفضل استاذ @محمود _ المصري مرفقك بعد التعديل حسب مافهمت . ووافني بالرد . M-111.rar

تفضل ...... Yamen-01-04-2026-111.rar

تمام بارك الله فيك وجعله في ميزان حسناتك

تفضل حساب_التاريخ3.xlsx

😈 للعلم أستاذ @منتصر الانسي ، انا ما زلت أبني أداتي ، وقد توصلت حالياً للإصدارات 2016 - 2019 تقريباً .. وانت قد قفزت بي لآخر لإصدار ههههههههه

انا حسبت الموضوع واحد من التحديات الخاصة بك 😅 365 الاصدار 64

ومن باب السؤال أستاذ @منتصر الانسي ، ما إصدار الأوفيس الذي استخدمته ؟؟ من باب الإحاطة بمعلومة 😊

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

وهذه مواضيع سابقة في المنتدى يمكن تقدر تحلها

قمت بتحويل إحدى الأدوات التي رفعتها للمكتبة شوف إذا بتقدر تفكها تحدي فتح ملف ACCDE.rar