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

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

شكرا استاذنا على المداخلة وهذه طريقة لبناء دالة على اكتاف Replace مع اخذ الاحتياط بحذف المسافات الفارغة الزائدة ان وجدت ' الصق هذه في وحدة نمطية عامة Public Function fnchang(vtext As String) Dim i As String i = Replace(vtext, "/", "-") i = Replace(i, "(", "-") i = Replace(i, ")", "-") Do While InStr(1, i, " ") > 0 i = Replace(i, " ", " ") Loop End Function ' تم تعديل الدالة نبهني الى الخطأ فيها اخي وحبيبي الاستاذ جعفر ' الصق هذا السطر في حقل جديد في الاستعلام text2: fnchang(text1) ، text1باعتبار هو اسم الحقل الذي سيجري عليه التغيير

ظهر الآن ان السؤال منقول .. وصاحب السؤال لا يعمل عليه وذكر ان كل مستخدم له حاسوبه الخاص الآن فهمت انهم في مبنى واحد .. وهذا يعني امكانية عمل شبكة بين الحواسيب ، وهذا يرجعنا الى تخمين الاستاذ جعفر ، وما سماه بالسؤال الساذج

جرب للهجري هذا ..... Me.RecordSource = "hijriDate" وغير الجدول للميلادي بنفس الطريقة

نعم ، صيغة السؤال تدل على هذا الاتجاه ، ولكن ، وكما قلت ، هو سؤال ساذج ، واتمنى يفاجأنا الجواب 😁 جعفر

السلام عليكم 🙂 الاكسس يعرض السجلات (في الجداول والاستعلامات والنماذج والتقارير) حسب تسلسل ادخالها ، اذا لم نعمل فرز وتصفية خاصة بنا 🙂 عليه ، للحصول على نفس تسلسل ادخال البيانات ، في التقرير ، احذف الفرز الذي عملته (المؤشر عليه باللون الاحمر) : . طبعا حل اخوي ابوخليل هو الافضل ، لأنه اصل لشروط قاعدة البيانات ، وقاعدة البيانات معناها: ادخال بيانات ، فرز وتصفية ، وعرض بيانات 🙂 جعفر

الامر ليس بهذه السهولة ، فلن تستفيد من مثال ارفقه لك دعنا نأخذ المسألة بالتفصيل لو ان البيانات القابلة للزيادة والتحديث عند المستخدمين ضمن جدول واحد لاصبحت العملية يسيرة جدا ولكنك تتحدث عن خمس جداول .. لذا انت من سيرفق المثال على النحو التالي : ارفق ثلاث قواعد بيانات داخل مجلد بعد ضغطها .. وقم بتسميتها مثلا : dataDB1 ,, dataDB2 ,, dataDB3 وتشتمل فقط (اكرر فقط) على الجداول التي يحدث فيها التحديث والاضافة عند المستخدمين بمعنى ان بياناتها تتغير وتختلف من مستخدم لآخر . ((( يجب ان تكون نسخة مطابقة من جداولك التي تعمل عليها ))) قم بتعبئة الجداول ببيانات كاملة مشابهة للواقع ( على الأقل سجلين في كل جدول ) بعد الاطلاع على جداولك سيتبين لنا ما يمكننا عمله ، حيث اتوقع اننا سنجد تعارض منطقي او عدم صلاحية الدمج في بعض الجداول حينها سوف ارى ما يجب عمله من اضافة او تعديل على بنية الجدول . ثم تأسيس استعلامات تحل محل هذه الجداول

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

سوف اعطيك طريقة فريدة .. ستذكرني كلما استخدمتها قم بتقسيم قاعدة البيانات القاعدة الخلفية التي تشتمل على الجداول : 1- قم باخذ نسخ منها بعدد المستخدين 2- قم بتسمية كل نسخة بما يدل على المستخدم ( يجب ان تختلف تسمياتها لاننا لاحقا سوف نضمها في مجلد واحد ) 3- اربط الواجهة مع جداول المستخدم الاول ثم سلمها له 4- اربط الواجهة مع جداول المستخدم الثاني ثم سلمها له 5 - وهكذا مع بقية المستخدمين 6- قبل ارسالها للمستخدم نضع نسخة منها بجانب الواجهة التي تخصك الآن اصبح عندك برنامج يشتمل على قاعدة الواجهات وبجوارها القواعد الخلفية الخاصة بكل مستخدم الآن قم بربط الجداول التي تشتمل على البيانات الخاصة بكل مستخدم من كل قاعدة بيانات ستلاحظ ان اكسس يقبلها ولكنه يعدل في اسماء الجداول المتشابهة بزيادة رقم يمكنك ايضا بعد الربط تغيير اسماء الجداول المرتبطة بما يدل على المستخدم . نأتي للزبدة : كل ما ستقوم به مستقبلا هو انك تستقبل قاعدة بيانات المستخدم وتلصقها في مجلد البرنامج ثم توافق على الاستبدال في برنامجك تعمل استعلاما للجداول المرتبطة المتشابهة لجمع البيانات .. وسيكون هو مصدر بيانات النموذج والتقرير بهذه الطريقة لن نحتاج الى فتح قواعد البيانات الواردة ولا الى جلب واستيراد ولا الى نسخ ولصق

السلام عليكم 🙂 الجوازات والبطاقات الشخصية والهويات الحكومية ، في اسفلها كود يسمى MRZ وفيه معلومات من الوثيقة ، الجواز ، وفي اسفله سطرين من كود MRZ : . والهوية ، وفي اسفلها 3 اسطر من كود MRZ : . وهناك عدة اجهزة (هي في الواقع سكانرات) التي يمكنها قراءة هذه الوثائق ، وتستعمل نظام OCR وتحول الصورة الى نص ، ومن ضمن هذه الاجهزة ، جهاز 3M CR100 https://www.gemalto.com/govt/document-readers/cr100 والظاهر ان هذا الجهاز معتمد من قِبل البوابة الالكترونية الموحدة لحجاج الخارج . . تنزيل وتنصيب برنامج التشغيل : http://www.3m.com/ssdcp/3M Swipe Readers/SDK/3M Swipe Reader SDK 1.2.1.2 Setup.exe خلونا نستعمل هذا الجهاز عن طريق الاكسس 🙂 بعد تنصيب برنامج تشغيل الجهاز ، يقوم برنامج الاكسس بتشغيل برنامج الجهاز في الكمبيوتر (فإذا ما عملت تنصيب للبرنامج ، اوقف عمل السطر : ) Private Sub Form_Load() On Error GoTo err_Form_Load 'turn ON the scanner xml program ' Call Restart_XML '<<< اوقفوا عمل هذا السطر . النموذج يكون جاهز على الحقل Line_0 ، والذي يبدا بأخذ نتيجة OCR ، . . وتكون النتيجة بهذه الطريقة (انا وضعت الارقام امام الاسطر) : 0'START 1'OCR Line 1: IDOMN1900000<<3<<<<<<<<<<<<<<< 2'OCR Line 2: 7008529M2018227OMN<<<<<<<<<<<6 3'OCR Line 3: ALI<MOHAMMED<HUSSAIN<<AL<MOOSA 4'MSR Track 1: 5'MSR Track 2: 6'MSR Track 3: 7'End . لعمل البرنامج ، اضطررت لعمل الاكواد بنفسي ، لأن SDK الجهاز كانت للغات اخرى غير VBA ، وهذه الوحدة النمطية التي تقوم بتفكيك الكود اعلاه ، سواء لجواز او بطاقة او فيزا : Public Function Parse_MRZ(frmN As String) On Error GoTo err_Parse_MRZ ' '08-06-2018 'by jjafferr ' Dim L1 As String Dim L2 As String Dim L3 As String Dim gDocType As String Dim Pass_Type As String Dim gLastName As String Dim gFirstName As String L1 = Replace(Forms(frmN)!Line_1, "OCR Line 1: ", "") L2 = Replace(Forms(frmN)!Line_2, "OCR Line 2: ", "") L3 = Replace(Forms(frmN)!Line_3, "OCR Line 3: ", "") gDocType = Mid(L1, 1, 1) Select Case gDocType Case "P", "V" 'passport , Visa Forms(frmN)!gDocType = gDocType 'LINE 1 Pass_Type = Mid(L1, 2, 1) 'Either < or Passport type Forms(frmN)!gIssuing = Mid(L1, 3, 3) gLastName = Mid(L1, 6, InStr(L1, "<<") - 6) gLastName = Replace(gLastName, "<", " ") Forms(frmN)!gLastName = Trim(gLastName) gFirstName = Mid(L1, InStr(L1, "<<") + 2, InStr(InStr(L1, "<<") + 1, L1, "<<") - InStr(L1, "<<") - 2) gFirstName = Replace(gFirstName, "<", " ") Forms(frmN)!gFirstName = Trim(gFirstName) Forms(frmN)!gDocNumber = Mid(L2, 1, 9) 'LINE 2 Forms(frmN)!gCountry = Mid(L2, 11, 3) Forms(frmN)!gDOB = DateSerial(Mid(L2, 14, 2), Mid(L2, 16, 2), Mid(L2, 18, 2)) Forms(frmN)!gGender = Mid(L2, 21, 1) Forms(frmN)!gDocExpiry = DateSerial(Mid(L2, 22, 2), Mid(L2, 24, 2), Mid(L2, 26, 2)) Forms(frmN)!gAddInfo = Mid(L2, 29, InStr(L2, "<<") - 29) Case "I", "A", "C" 'ID Forms(frmN)!gDocType = Mid(L1, 1, 2) Pass_Type = Mid(L1, 2, 1) 'Either < or completing the first letter Forms(frmN)!gIssuing = Mid(L1, 3, 3) Forms(frmN)!gDocNumber = Mid(L1, 6, InStr(L1, "<<") - 6) Forms(frmN)!gDOB = DateSerial(Mid(L2, 1, 2), Mid(L2, 3, 2), Mid(L2, 5, 2)) 'LINE 2 Forms(frmN)!gGender = Mid(L2, 8, 1) Forms(frmN)!gDocExpiry = DateSerial(Mid(L2, 9, 2), Mid(L2, 11, 2), Mid(L2, 13, 2)) Forms(frmN)!gCountry = Mid(L2, 16, 3) gFirstName = Mid(L3, 1, InStr(L3, "<<") - 1) 'LINE 3 gFirstName = Replace(gFirstName, "<", " ") Forms(frmN)!gFirstName = Trim(gFirstName) gLastName = Mid(L3, InStr(L3, "<<") + 2) gLastName = Replace(gLastName, "<", " ") Forms(frmN)!gLastName = Trim(gLastName) End Select Exit_Parse_MRZ: Exit Function err_Parse_MRZ: If Err.Number = 9 Then 'susbcription out of order, ignore Resume Next ElseIf Err.Number = 13 Then 'Type mismatch, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_Parse_MRZ End If End Function برنامجي الذي في الخدمة ، يقرأ بيانات الجوازات والهويات في اقل من 3 ثواني ، بالأضافة الى قراءة باركود بعض الهويات الاخرى ، وادخال يدوي لأنواع اخرى من الهويات ، لهذا السبب كان يتطلب مني استعمال هذه الاحداث🙂 Public Sub Line_0_BeforeUpdate(Cancel As Integer) Private Sub Line_0_KeyDown(KeyCode As Integer, Shift As Integer) Private Sub Line_0_AfterUpdate() Private Sub Line_7_AfterUpdate() . احد اهم الامور التي اخذت مني وقت طويل لمعرفتها هي ، يجب ان تكون لغة الكيبورد بالانجليزي ، وقت قراءة البطاقة ، وإلا فالنتائج تعطيك خطأ ، لهذا السبب فالبرنامج تلقائيا يحول اللغة الى انجليزي ، لما التركيز يكون في حقل Line_0 🙂 الجدول و الكود قد يكون فيه بقايا من برنامجي ، ولكن لن يضروكم ان شاء الله 🙂 جعفر CR100 card reader.zip

يمكنك استخدام المعادلة التالية لاستخراج الفرق بالشهور =DATEDIF(H2;P2;"m") مثال 12/4/2022____27/4/2029________النتيجة هي 96 شهر وهده ادا كانت لك رغبة باستخراج النتيجة بالاعداد الكسرية =FRACTION.ANNEE(H2;P2)*12 12/4/2022____27/4/2029________ النتيجة هي 96.5 شهر ونصف Copy of Book13(2).xlsx

صارت لدي حاجة لمثل هذا .. 🙂 عندي برنامج يقوم بحفظ ملفات PDF بنفس أسماء الأشخاص حسب الموجود في الجدول .. كل شخص له ملف PDF باسمه .. لكن أحيانا يتم إدخال الاسم هكذا : " الفاضل / محمد أحمد سلامة " واللويندوز يرفض علامة الـ / في أسماء الملفات وعلامات أخرى مثل : #$%^<> حسب ما أذكر .. لذلك أنشأت دالة تقوم بتتبع هذه العلامات في الاسم قبل حفظ الملف واستبدالها بالرمز " - " أو مسافة فارغة " " (ويمكنك تحديد البديل كما تشاء ) .. بدون تغيير البيانات في الجدول طبعا .. وهذه هي الدالة التي أنشأتها .. ويمكن تعديلها حسب الحاجة وتغيير الرموز المطلوبة فيها وتعيين البديل .. Public Function RemoveSymbolsFromText(strGivenTxt As String, Optional ReplacmentTxt As String = "") As String Dim Txt As String Dim R As String R = ReplacmentTxt Txt = strGivenTxt Txt = Replace(Txt, "!", R) Txt = Replace(Txt, "@", R) Txt = Replace(Txt, "#", R) Txt = Replace(Txt, "$", R) Txt = Replace(Txt, "%", R) Txt = Replace(Txt, "^", R) Txt = Replace(Txt, "*", R) Txt = Replace(Txt, "\", R) Txt = Replace(Txt, "|", R) Txt = Replace(Txt, "/", R) Txt = Replace(Txt, ".", R) Txt = Replace(Txt, "?", R) Txt = Replace(Txt, """", R) Txt = Replace(Txt, "'", R) Txt = Replace(Txt, "<", R) Txt = Replace(Txt, ">", R) Txt = Replace(Txt, "؟", R) Txt = Replace(Txt, "~", R) Txt = Replace(Txt, "&", R) RemoveSymbolsFromText = Txt End Function وتستدعيها هكذا : RemoveSymbolsFromText(strGivenTxt, "_")

إبداع بتكامل بناء بين أساتذة فضلاء .. شكر الله لكم يا كرام .. وحعل ما قدمتموه في ميزان حسناتكم وبركة في أعماركم وأعمالكم وأهلكم وولدكم..

Replace(Replace(Replace([text1];"/";"-");"(";"-");")";"-")

جرب المرفق ......... بحث احترافي.accdb

عليكم السلام .. اهلا ابا انس Me.text1 = Replace([text1], "/", "-") ' في الحدث المناسب في المحرر text2 : Replace([text1]; "/"; "-") ' في الاستعلام لاحظ انك ان استخدمت الكود سوف تتغير وتتحدث البيانات في الجدول اما ان استخدمت الاستعلام فستبقى البيانات في الجدول كماهي وتستخدم الاستعلام لعرض النتيجة الجديدة لذا ننصح بالعمل على نسخة للتجربة حتى اذا اصبحت النتيجة حسب المطلوب تطبق عملك على برنامجك

بارك الله فيك واحسن الله اليك وطال الله في عمرك ورفع قدرك.

هو اشارة الى سؤالي 🙂 . انت لم ترد على سؤالي: هل جميع من سيتعامل مع البرنامج موجودين في مبنى واحد ؟ وهل المبنى فيه شبكة تربط جميع كمبيوترات مدخلي البيانات والمستخدم الرئيسي الذي يجمع البيانات ؟ جعفر

بعد تسمية النطاقات بخاصية (Name Manager) تم وضع معادلة البحث التالية =INDEX(Data!$C$3:$D$300;EQUIV('شهادة صف ثالث'!$K$47;Data!$C$3:$C$300;0);2) اما بالنسبة للصورة لم يتم وضع اي اطار خاص بها يمكنك تغيير مكانها كيفما شئت

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

أعتقد أن المثال الذي يريده الأخ قاسم يتعلق ببرنامج يتم توزيعه على أفرع المؤسسة في عدة مدن مختلفة .. وبعد مدة معينة يتم تجميع البيانات الموزعة على الأفرع في البرنامج الرئيسي لإدارة المؤسسة .. والمثال الذي ذكره الأستاذ @ابوخليل يعالج هذه القضية وهي فكرة إبداعية .. فقط يحتاجله بعض البهارات من الـVBA لجعل العملية تصير بشكل أوتوماتيكي 🙂 ..

1) لاحظت ان عدد الطلبة يفوق 200 طالب يستحيل انك تضيف كل صورة لوحدها 🤔🤔 اليك اخي الفاضل هدا الكود الدي سيمكنك من اضافة الصور دفعة واحدة ومرتبة (قبل تشغيل الكود تاكد من وقوفك على الخلية المراد اضافة الصورة اليها) 2) وهدا رابط شرح طريقة اضافة الصور للملف : https://streamable.com/ti3tnn Sub InsertMultiplePictures_MH() Dim Pictures() As Variant Dim PictureFormat As String Dim Rng As Range Dim PicShape As Shape On Error Resume Next Pictures = Application.GetOpenFilename(PictureFormat, MultiSelect:=True) xColIndex = Application.ActiveCell.Column If IsArray(Pictures) Then xRowIndex = Application.ActiveCell.Row For lLoop = LBound(Pictures) To UBound(Pictures) Set Rng = Cells(xRowIndex, xColIndex) Set PicShape = ActiveSheet.Shapes.AddPicture(Pictures(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height) xRowIndex = xRowIndex + 1 Next End If End Sub ولازالة الصور القديمة Sub DeleteImage() Dim pic As Picture For Each pic In ActiveSheet.Pictures If Not Application.Intersect(pic.TopLeftCell, Range("D3:D300")) Is Nothing Then pic.Delete End If Next pic End Sub تم اضافة الاكواد للملف المرفق شهادات صف ثالث_M-H.rar

اشر اطراءك اخي واستاذي الفاضل احمد ... بارك الله فيك

وما فى احلى من هيك اخى واستاذى الغالى جزاك الله خيرا 💐

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خيرا وفيك بارك الله اخى @athal1 كفيت ووفيت ببساطه معلمنا وشيخنا الجليل جزاك الله خيرا 💐

بارك الله فيك استاذ مجدى وزادك الله من فضله

أنظر لهذا المرفق أخي قاسم 🙂 يعمل بنفس الفكرة .. هذا النموذج فيه كل ما تحتاجه بداية من جلب الصور + وإنشاء المجلدات المتتالية إذا كانت غير موجودة ( يعمل لكل سجل أو موظف مجلد خاص به ) + نسخ الصورة بجانب قاعدة البيانات + إمكانية نقل البرنامج إلى أي مكان آخر مع ضمان عمل الصور + حذف الصورة من المجلد . << تضغط على الصورة لفتحها >> إدارة المرفقات.rar

هل هذا ما تريد ؟ لفتح الصوره خارج الاكسيس Dim ImgPath As String ImgPath = CurrentProject.Path & "\IMG\" & txtEmpID & ".jpg" Application.FollowHyperlink ImgPath ايضا لجعل الصوره تتغير تلقائيا عند التنقل من موظف الى اخر فى حدث فى الحال Private Sub Form_Current() Me.CImg.Picture = CurrentProject.Path & "\IMG\" & Me.txtEmpID & ".jpg" End Sub اتمنى ان يكون هذا ما تبحث عنه Test.rar

أحسنت استاذ مجدى كل عام وأنتم بخير

أحسنت استاذ مجدى بارك الله فيك

جزاك الله خير الثواب استاذ مجدى

بارك الله فيك استاذ مجدى وزادك الله من فضله

بارك الله فيك وكل عام وانتم بخير

وعليكم السلام -يمكنك ذلك بجعل التنسيق هكذا [$-,2000000]0.00_);[Red](0.00) TEST1.xlsx

يمكنك ذلك بهذه المعادلة =COUNTIFS($C:$C,J5,B:B,"<>"&"") Book2.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة على الرغم ان طلبك تكرر كثير جداً وكان عليك البحث بالمنتدى قبل رفع مشاركتك =IF($B1=0,6,IF(AND($B1>=1,$B1<=39),5,IF(AND($B1>=40,$B1<=49),4,IF(AND($B1>=50,$B1<=69),3,IF(AND($B1>=70,$B1<=89),2,IF(AND($B1>=90,$B1<=100),1,"")))))) 1.xlsx

جزاك الله خير الثواب استاذ مجدى

أحسنت استاذ مجدى بارك الله فيك

أحسنت استاذ موسى عمل ممتاز جعله الله فى ميزان حسناتك

أخى الكريم جمال يعنى i=4 to 250 أى تحديد النطاق للإخفاء من الصف الرابع الى الصف 250 أما بالنسبة Cells(i,6).EntireRow.Hidden=True وذلك يعنى أن العمود السادس وهو العمود F وبناءاً عليه يتم الإخفاء للصف كله بارك الله فيكم

جرب هذا بالمعادلات السادة عظماء منتدى اوفيسنا العظيم برجاء المساعدة في ترحيل عمود بشروط من برنامج مرتبات.rar

تفضل أخى جمال كود اخفاء صف بناءا على خلية فارغة فيه.xlsm

بعد اذن الأستاذ شريف ممكن تجرب هذا ترتيب عشوائى.xlsm

تفضل أخى معادلة المساحة.xlsx

ممكن تجرب كده تنسيق مخصص.xlsm

لقد تم الحل من قبل ترحيل المتأخرين.xlsm

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

تفضل أخى مطلوب ملف ترتيب عشوائي.xlsm

مطلوب ملف ترتيب عشوائي.xlsm تفضل أخى