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

السلام عليكم ورحمة الله وبركاته بعد اذن معلمنا واستاذنا محمد هشام جدول2.xlsm

لاحظت ان جميع درجات الحضور في الشهادة للفصل الثاني للصف الأول والثاني على سبيل المثال = 140 ( هل النتيجة صحيحة ؟ ) أيضاً البطئ أصبح في التنقل بين الصفحات للتقرير الخاص بالشهادة ايضاً وجب التنويه الى تبديل مصدر بيانات مربع النص Text355 في تقرير الشهادة من fsl_id إلى term_Num على ما اعتقد ..

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

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

الجواب كلش واضح....عاشت ايديك استاذ العزيز ...بارك الله فيك وجزاكم الله خيرا....

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

وعليكم السلام ورحمة الله وبركاته .. لعدم وضوح كامل الصورة من المطلوب من جهة علاقة الجداول ببعضها البعض من خلال مفتاح الربط = مساحة القطعة ، تم ربط الجدولين بعلاقة One-To-Many ، أيضاً علاقة المالك لم تكن واضحة في النموج ، لذا تركت دون تغيير . واليك المرفق التالي جربه واخبرني بالنتيجة .. مساحات.accdb

وعليكم السلام ورحمة الله تعالى وبركاته Option Explicit Private Const ShName As String = "جدول عام" Sub Coloring_Classes() On Error GoTo EndClear SetApp False Dim Sh As Worksheet: Set Sh = ThisWorkbook.Sheets(ShName) Dim i As Long, r As Long, c As Long, ColAL As Long, ColA As Long Dim tmps As Object: Set tmps = CreateObject("Scripting.Dictionary") Sh.Range("B6:AJ23").Interior.ColorIndex = xlNone ColAL = Sh.Cells(Sh.Rows.Count, "AL").End(xlUp).Row ColA = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row For i = 5 To ColAL If Len(Sh.Cells(i, "AL").Value) > 0 Then If Sh.Cells(i, "AM").Interior.ColorIndex <> xlColorIndexNone Then tmps(Sh.Cells(i, "AL").Value) = Sh.Cells(i, "AM").Interior.Color End If End If Next i For r = 5 To ColA If tmps.exists(Sh.Cells(r, "A").Value) Then For c = 2 To 36 With Sh.Cells(r, c) If Len(.Value) > 0 Then .Interior.Color = tmps(Sh.Cells(r, "A").Value) End With Next c End If Next r EndClear: SetApp True End Sub '""""""""""""""""""""""""""""""""""""""" Private Sub SetApp(ByVal enable As Boolean) With Application .ScreenUpdating = enable .EnableEvents = enable .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With End Sub جدول.xlsm

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) كثير منا يبحث عن QR ( رمز إستجابة سريعة ) ولكن ملوّن !! ونستطيع التحكم باللون حسب حاجته !! اليوم بطريقة بسيطة يتم تنفيذها بكل سلاسة سنحقق ذلك . والفائدة على سبيل المثال :- الإبتعاد عن النمط التقليدي اللون الأسود المعروف به رمز الـ QR .. شكل جمالي ملفت لرمز الإستجابة QR .. التمييز بين الأقسام أو الأستخدام للـ QR حسب حاجة المشروع . فمثلاً ( قسم المحاسبة لهم رمز باللون الأزرق ، قسم الصيانة لهم رمز باللون الأسود ، المعلمين رمز باللون الأحمر ..... إلخ . والكثير من الإستخدامات التي لا تخطر ببالي حالياً . تأكد من تثبيت إصدار NET Framework 4.0 أو أعلى على جهازك . تستطيع التحميل من هذا الرابط ، أو بشكل مباشر من هذا الرابط . برنامج ImageMagick . ويمكنك تحميله من رابط الموقع من هذا الرابط ، أو بشكل مباشر من هذا الرابط . ملفات الـ DLL ( zxing.interop.dll ، zxing.dll ، zxing.interop.tlb ) والتي هي مكتبات سيتم إضافتها الى محرر الأكواد VBA في آكسيس لاحقاً طريقة التثبيت والإضافة ( موجودة في الملف المرفق ) . أولا يلزمنا تسجيل المكتبات المستخدمة في المشروع ( وهنا سنستخدم ZXing لتنفيذ مهمتنا ) وطبعاً سنحتاج مكتبة QRCode ، ويجب تسجيلها ليتم إضافتها في آكسيس في مكتبات الـ VBA > Tools > References . فكيف ننفذ هذه الخطوة المهمة . بعد التأكد من تثبيت المستلزمين السابقين :- افتح موجه الأوامر CMD كمسؤول ( Run as Administrator ) . قم بكتابة السطر التالي لتسجيل المكتبة :- cd C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library --------------------- حيث هنا ، المسار C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library Dll مسار المجلد الذي يحتوي ملفات الـ التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك قم بكتابة السطر التالي :- C:\Windows\Microsoft.NET\Framework64\v4.0.30319\regasm.exe /codebase zxing.interop.dll ومن المفترض أن تظهر معك النتيجة بهذا الشكل :- أما خلاف ذلك فأن عملية تسجيل المكتبة لم تنجح ولن يتم إضافتها إلى محرر الأكواد VBA كما نريد . الآن لاستكمال عملية تسجيل المكتبة وإضافتها الى محرر الأكواد VBA ، نطبق آخر خطوة وهي :- C:\Windows\Microsoft.NET\Framework64\v4.0.30319\regasm.exe /codebase "C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\zxing.interop.dll" /tlb:"C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\zxing.interop.tlb" --------------------- حيث هنا ، المسار C:\Users\Golden\Desktop\QR\QrCodeZXing\ZXing_Library\ Dll مسار المجلد الذي يحتوي ملفات الـ التي تحدثنا عنها من ضمن المستلزمات ، وسيكون متغيراً حسب جهازك الآن نفتح قاعدة بيانات جديدة ، ونذهب إلى محرر الأكواد ( Tools > References ) ، ونبحث عن المكتبة التالية كما في الصورة :- الآن وبعد إتمام عملية التسجيل للمكتبة المطلوبة وتثبيت المستلزمات السابقة ، نقوم بإنشاء نموذج يحتوي على مربع نص ، وعنصر صورة ، و زر لتنفيذ العملية . ثم نأتي إلى الأكواد ، وما سنحتاجه الآن هو مديول يحتوي على الدالتين التاليتين :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '********************************************** Option Compare Database Option Explicit #If VBA7 Then Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Function Encode_To_QR_Code_To_File(str As String, Optional foregroundColor As String = "black", Optional backgroundColor As String = "white") As String On Error GoTo ErrorHandler Dim writer As IBarcodeWriter Dim qrCodeOptions As QrCodeEncodingOptions Dim filepath As String Dim folderPath As String folderPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "QRImage" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath End If filepath = folderPath & "\QRCode_" & Format(Now, "yyyyMMdd_hhmmss") & ".png" Set qrCodeOptions = New QrCodeEncodingOptions Set writer = New BarcodeWriter writer.Format = BarcodeFormat_QR_CODE Set writer.Options = qrCodeOptions qrCodeOptions.Height = 200 qrCodeOptions.Width = 200 qrCodeOptions.CharacterSet = "UTF-8" qrCodeOptions.Margin = 1 qrCodeOptions.ErrorCorrection = ErrorCorrectionLevel_H writer.WriteToFile str, filepath, ImageFileFormat_Png If Change_QR_Code_Colors_ImageMagick(filepath, foregroundColor, backgroundColor) Then Encode_To_QR_Code_To_File = filepath Else Encode_To_QR_Code_To_File = "" End If Exit Function ErrorHandler: Encode_To_QR_Code_To_File = "" MsgBox "حدث خطأ أثناء إنشاء QR Code: " & Err.Description, vbCritical, "خطأ" End Function Function Change_QR_Code_Colors_ImageMagick(filepath As String, foregroundColor As String, backgroundColor As String) As Boolean On Error GoTo ErrorHandler Dim batchFilePath As String Dim batchContent As String Dim result As Long If Dir(filepath) = "" Then MsgBox "لم يتم العثور على الملف: " & filepath, vbCritical, "خطأ" Exit Function End If batchContent = "@echo off" & vbCrLf & "magick " & Chr(34) & filepath & Chr(34) & " -fill " & foregroundColor & " -opaque black -fill " & backgroundColor & " -opaque white " & Chr(34) & filepath & Chr(34) batchFilePath = Environ$("temp") & "\ChangeQRColors.bat" Open batchFilePath For Output As #1 Print #1, batchContent Close #1 result = Shell("powershell -Command Start-Process " & Chr(34) & batchFilePath & Chr(34) & " -Verb RunAs", vbHide) DoEvents Sleep 3000 If Dir(filepath) <> "" Then Change_QR_Code_Colors_ImageMagick = True Else Change_QR_Code_Colors_ImageMagick = False End If Kill batchFilePath Exit Function ErrorHandler: Change_QR_Code_Colors_ImageMagick = False MsgBox "حدث خطأ أثناء تغيير ألوان QR Code: " & Err.Description, vbCritical, "خطأ" End Function وفي حدث عند النقر لزر التنفيذ ، الكود التالي :- Private Sub Command20_Click() Dim imagePath As String Dim folderPath As String If IsNull(Me.Text0) Or Me.Text0 = "" Then MsgBox "QR Code الرجاء إدخال نص لإنشاء", vbExclamation, "" Exit Sub End If Dim foregroundColor As String Dim backgroundColor As String foregroundColor = "Blue" backgroundColor = "white" imagePath = Encode_To_QR_Code_To_File(Me.Text0, foregroundColor, backgroundColor) If imagePath <> "" Then Me.Image0.Picture = imagePath MsgBox " بنجاح QR Code تم إنشاء", vbInformation, "" folderPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "QRImage" Else MsgBox "فشل في إنشاء QR Code", vbCritical, "" End If End Sub الآن لتغيير ألوان الـ QR كخلفية أو لون الرمز نفسه ، تستطيع التعديل من خلال السطرين التاليين في زر التنفيذ :- foregroundColor = "Blue" <---- هنا لون الرمز نفسه backgroundColor = "white" <---- هنا لون الخلفية وهنا نكون قد وضحنا المطلوب وطريقة تنفيذه خطوة بخطوة .. QrCodeZXing.zip

وفى هذا الرابط شرح الـ Command Line الخاص بالاداة المستخدمه من الموقع الرسمى لها https://zint.org.uk/manual/chapter/4

ومشاركة مع استاذى واخى الحبيب الاستاذ @Foksh طريقتى المتواضعة zint barcode generator V2.zip

QR Generator 2.zip هذا مثال أستاذي الكريم 😊

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

الدرس الثالث: استخدام جهاز قارئ الباركود في الإكسيل كثير من الناس يعتقد أن استخدام جهاز قراءة الباركود يحتاج نظام وأجهزة خاصة للتعامل معه، ولكن الأمر أبسط مما كنت أتوقعه، في ا لدرس الأول حللنا عقدة تكوين شريط الباركود ، لم يبق لدينا إلا أن نربطه في قاعدة البيانات في الإكسيل. كل ما عليك هو التالي: 1- طباعة ملصقات الباركود على ورقة A4. 2- بناء قاعدة البيانات في الإكسيل. 3- بناء صفحة الإدخال في الإكسيل. بالنسبة لآلية عمل جهاز القارئ يكون لو بعملتين هما: كتابة الكود ثم enter. فلذلك ينتقل مؤشر الماوس إلى السطر التالي. ولكي نجعل المؤشر يبقى في مكانه نقوم بحماية الصفحة (انظر الشرح في الملف المرفق) لا أعتقد أنكم تحتاجود درس آخر .. لأننا وصلنا إلى الفكرة ومبرووووك عليكم التعامل مع الباركود. barcode reading.rar

الدرس الأول: مولد الباركود أول خطوة لمعرفة كيفية قراءة الباركود هو طريقة توليدها ومن ثم ربطها بالبرنامج. تختلف صياغة الباركود نظراً للكود الذي يتبعه والتي تحدد معايير رسم وقراءة رموز الباركود، مثل كود 93 و كود 39 وكود 128، ولهذا السبب يشتكي البعض من عدم تمكنه من قراءة رموز الباركود، ولهذا في هذا الدرس سنعتمد على كود 128 وكود QR لأنهما الأكثر شيوعاً وتقبل معظم الأجهزة.. هناك برامج ومواقع كثيرة تقوم بتوليد الباركود، ونحن في هذا الدرس قمنا بتوليد الباركود عن طريق موقع خارجي من خلال المرفق التالي. barcode generator.rar

لي تجربة منذ سنتين في قراءة الباركود ببرنامج بالإكسيل وهو شغال مية المية. الخطوات كالتالي: 1- تحميل برنامج لصناعة الباركود (مثل barcode creator). 2- من خلال البرنامج يتم صناعة الباركود. 3- كل باركود يقابله رقم مرجعي مؤلف من أرقام وأحيانا رموز. 4 - تنقل هذه الرموز إلى الإكسل كمرجع لقاعدة الأصناف لديك. 5- لا تنسى طباعة الباركود لقراءتها من قارئ جهاو الباركود. 6- اشتري جهاز قارئ الباركود والذي لا يتعدى سعره عن 30 دولار. 7- استخدم معادلة vloookup للبحث عن الأصناف عن طريق رقم الباركود. 8- ضع مؤشر الماوس على الخلية اللي بها رقم الباركود واستخدم جهاز قراءة الباركود وتمتع بالبرنامج.

السلام عليكم هذا حل بالاكواد كود ملئ اليست دون تكرار Sub RabieCh() Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sales Report") Dim lrw As Long: lrw = ws.Cells(Rows.Count, 1).End(xlUp).Row Dim keyArray(): keyArray = ws.Range("A3:A" & lrw).Value Set sDic = CreateObject("Scripting.Dictionary") Dim i As Long For i = LBound(keyArray) To UBound(keyArray) If Not IsEmpty(keyArray(i, 1)) Then sDic(keyArray(i, 1)) = "" Next i If IsArray(keyArray) Then With Sheet2.ComboBox1 .List = sDic.keys: .ListRows = 20 .MatchEntry = fmMatchEntryNone .TextAlign = fmTextAlignRight End With choix1 = sDic.keys End If End Sub كود البحث داخل اليست (فلترة) If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, choix1, 0)) Then Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare) Me.ComboBox1.DropDown End If لم افهم اين تريد انتائج ان شات وضح الامر لاعدل في الاكواد تحياتي للجميع قائمة منسدلة بدون تكرار مع إمكانية البحث داخل القائمة.rar

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