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

الاخوة الاعزاء اسعد الله اوقاتكم بكل خير .. في عدة منتديات اجد كثير من المستخدمين يجدون صعوبة في جلب الصورة من الاسكانر لنموذج الاكسس و رأيت امثلة يصعب التعامل معها للمبتدئين و متوسطي الخبرة اليوم اقدم لكم نموذج سهل للتعامل مع الصورة ( صورة من رابط خارجي - صور من الماسح الضوئي - صورة من الجهاز ) كما وضعت متغيير لتسمية الصورة الممسوحة من الاسكانر تفاديا للتكرار من خلال التاريخ و الوقت الحالي كمان ارفقت صورة للمكتبات المستخدمة ليستفيد الجميع منها اتتمنى ان يحوز على استحسانكم .. و دمتم في رعاية الله و حفظه من فضلكم ليس هناك داعى لعمل اقتباس عند الرد فهذا يقوم بدوره بتشتيت المطلع والباحث عن نفس الموضوع مستقبلاً مثال للتعامل مع الصور.mdb

لا تكمن المشكله فى صورة واحدة فقط انما مع مسح اكثر من ورقة دفعة واحدة adf Automatic Document Feeder

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

جرب المرفق مقارنه.mdb

بعد اذن اخي حسين هذا الكود Option Explicit Sub copy_Form_to() Dim M As Worksheet: Set M = Sheets("Main") Dim L As Worksheet: Set L = Sheets("list") If Not IsNumeric(L.Range("g5")) Or L.Range("g5") = 0 Then Exit Sub If Not IsNumeric(L.Range("I5")) Or L.Range("I5") = 0 Then Exit Sub Dim lrM%: lrM = M.Cells(Rows.Count, 3).End(3).Row Dim RgC As Range: Set RgC = L.Range("C6:C35") L.Range("b5").CurrentRegion.Offset(1).ClearContents Dim My_Min: My_Min = Application.Min(L.Range("g5:I5")) Dim My_Max: My_Max = Application.Max(L.Range("g5:I5")) If My_Max > lrM - 2 Then My_Max = lrM - 2 Dim t%, K% Dim r%, c%, X% r = 6: c = 3 My_Min = Int(Abs(My_Min)): My_Max = Int(Abs(My_Max)) For t = My_Min To My_Max On Error Resume Next X = M.Range("c:c").Find(t, lookat:=1).Row If Err.Number Then Err.Number = 0: GoTo next_t If X Then K = K + 1 If K = (RgC.Rows.Count) * 2 + 1 Then Exit For L.Cells(r, c - 1) = t: L.Cells(r, c) = M.Cells(X, 4) r = r + 1 If K = RgC.Rows.Count Then r = 6: c = c + 2 End If next_t: Next End Sub الملف مرفق aaaa.xlsm

تفضل اخي الكريم حساب التقاعد2003.mdb

أما إذا أردنا دمج الاسطر فقط دون اضافة فاصلة، بيتم استبدال السطر التالي 'replace with comma .Replacement.Text = ", " بالاتي ' replace only without comma .Replacement.Text = " "

السلام عليكم و رحمة الله و بركاته في المثال المرفق آلة حاسبة بمميزات رائعة الة حاسبة.rar

سؤال : هل يمكن حصر رموز الأخطاء التي تظهر في رسائل نظام الأكسيس ، للتعرف على وصف كل منها ، ضمن جدول و تطبيق للبحث يمكن من خلاله البحث عبر شبكة الانترنت ( Google تحديدا ) عن أسباب الخطأ و حلوله ؟ الجواب : نعم و الحل في التطبيق المرفق تنويه : الجدول يحمل 2977 رمز خطأ و و صفه باللغة الانجليزية ، هذه دعوة لتوسيع التطبيق و اضافة تراجم لأوصاف رموز الأخطاء في الجدول ، مع وصف للحلول و الحالات التي تطلق رسائل الخطأ لكل رمز ، لعموم الفائدة ، كما يمكن استخدامه كمكتبة شخصية لتجميع الملاحظات حول الاخطاء التي تواجه كل منا . و الله من وراء القصد ... NA__ErrorCodeArchive.accdb

السلام عليكم ورحمة الله وبركاته لقد أنشأت برنامج بسيط وجمعت به الأكواد التي نسنتخدمها باستمرار وصممته بحيث تكون الواجهة عبارة عن شاشة يتم تجميع بها الأكواد المراد نسخها الي شاشة الفيجوال بيسك لمشاهدة كيف يعمل البرنامج من هذا الرابط بنك الأكواد - demo-24-4-2019.accdb

فورم لترحيل اى عدد معين من البيانات الى صفحة الترحيلات الفيديو الصورة

أعجبتني فكرة الرجستري جرب هذا التعديل: za-font style and align-LAST.rar

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

وعليكم السلام-تفضل لك ما طلبت جمع نطاق من ورقه إلى أخرى.xlsx

هذه محاولة ان لم يعجبك انتظر احد الاساتدة ليجيبك Option Explicit Sub copy_list() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr, x, r Dim rng1 Dim rng2 Application.ScreenUpdating = False Set ws1 = Sheets("main") Set ws2 = Sheets("list") With ws2 .Range("b6:c10000").ClearContents Set rng1 = .Range("g5") Set rng2 = .Range("i5") If rng1 = "" Or rng2 = "" Then Exit Sub r = 6 lr = ws1.Cells(Rows.Count, "c").End(xlUp).Row For x = 3 To lr Select Case ws1.Cells(x, "c").Value2: Case rng1 To rng2 .Range("b" & r).Resize(1, 2).Value = ws1.Cells(x, "c").Resize(1, 2).Value r = r + 1 End Select Next x End With Application.ScreenUpdating = True End Sub aaaa.xlsm

تفضل هذا التعديل اخي الكريم Overtime2019.accdb

ربنا يكرمك كلنا نتعلم من بعض وللاستفادة لعامة الإخوة غيرنا المتغير الذى نحفظ فيه قيمة ناتج الجمع من Integer إلى Double حيث يمكن وجود علامة عشرية و أرقام بعدها

جرب المرفق kera11.accdb Dim myc As Double

:: الجداول هي التي تحفظ البيانات وليس حقول النموذج غير المنظمة. عموما ليس لدي طريقة للحفظ في النموذج.

وعليكم السلام-تفضل وذلك بالتنسيقات الشرطية Expire.xlsx

جزاك الله كل خير استاذى الكريم

جرب المرفق اجمالي.xlsm

غير الماكرو بهذا Sub TEST() Dim lr With Sheets("HR") lr = .Cells(Rows.Count, 1).End(3).Row + 1 If Application.WorksheetFunction.CountIf(.Range("A5:A10000"), .Range("y1")) > 0 _ Then MsgBox "الرقم الذي ادخاله موجود في القائمة", vbInformation: Exit Sub If .[y1] = "" Then Exit Sub .Range("a" & lr).Value = .[y1].Value .Range("e" & lr).Resize(1, 31).Value = .Range("am6").Resize(1, 31).Value End With End Sub

اخي الكريم اجعل التنسيق ارقام ثابته كما في الصورة

كان يجب تحميل مثال عما تريد لكن جرب هذا الملف wwithout Breakets.xlsx

اذا تفضل هذا التعديل اخي الكريم حساب التقاعد.accdb

مرورك هو الأجمل اخي الكريم ... شكرا لك

اخي الكريم فقط قم بإزالة عمود التاريخ و بعدها ستحصل على سجل محمد فقط

وضعت مشاركتي ولم اشاهد ردك تقبل تحياتي

:: قاعدة بياناتك مافيها تقرير ؟ عموما قدمت لك فكرة وعليك السلام والتطبيق ... ده اقتراحي في القضية . Microsoft Office Access 2007 قاعدة بيانات جديد __.accdb

مرحبا اخ عبدالفتاح هناك احتمالات والله اعلم وبالترتيب 1. يمكن ان ناتج الجمع في الكود قيمة خالية لاسباب عدة فتتحول القيمة الى صفر باستخدام nz .. هنا تاكد بعمل مسج بكس لتحديد المشكلة 2. اذا اعلاه تم التاكد بان الرسالة تعطي نص فانظر الى تنسيق مربع النص من الخصائص او هات مرفق خفيف به المشكلة بالتوفيق

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

اعتذر منك لم افهم المطلوب بشكل صحيح على كل حال لحساب المجموع التراكمي Nz(DSum("[حقل المجموع]";"الجدول";"[id]<=" & [id]);0)

شكراً أ / نبيل على تعاونكم

بتوفيق

حل رائع الاستاذ/ @د.كاف يار ولكن حسب ما فهمت من السؤال، الأخ @Alsalim1 يريد اضافة 1% كل سنة بعد تجاوز خدمة 20 سنة على 80% من أصل الراتب ، اذا كان المطلوب حسب فهمي جرب معادلة تالية: =[الراتب]/100*80+(([الراتب]/100)*IIf([مدة العمل]>20,(Nz([مدة العمل])-20),0))

السلام عليكم برنامج صغير جدا لأرشفة الوثائق كل شخص 10 صور مطلوب أفكار أحسن من الطريقة اللي عملتها المرفقة برنامج ارشفه.accdb

شوف عملت لك توسط وحفظ لون الخط كمل الباقي لان وقتي والله مايسمح هي نفس الفكرة za-font style and align-LAST.mdb

السلام عليكم استعمل هذا الكود mdb_Path_Name = CurrentProject.Path & "\db.accdb" 'مسار القاعدة الثانية DoCmd.TransferDatabase acExport, "Microsoft Access", mdb_Path_Name, acReport, "report112", "تقرير شهري", False

كما قال لك اخي حلبي اتفضل هذا بدون ضغط فقط اضف مجلد بجوار الملف واجعل اسمه StPic Database3 (1).accdb

وعليكم السلام السؤال الاول الافضل وضع مرفق لتتضح الفكره المطلوبة فكتابة كود بناء على شروط يتطلب معلومات اكثر السؤال الثاني بخصوص معلومات المؤسسة في التقرير فيكون عن طريق انشاء جدول بمعلومات المؤسسة مثلا اسم الموسسة العنوان ارقام الهاتف البريد الالكتروني السجل التجاري بعد اعداد التقرير نقوم بوضع مربع نص غير منظم ونستدعي المعلومات عن طريق دالة DLookUp الكود المستخدم للنموذج المرفق حمل الملف المرفق وسوف يساعدك على فهم الفكرة =DLookUp("[اسم المؤسسة]";"المؤسسة") المؤسسة.accdb

بارك الله فيك والحمد لله الذى بنعمته تتم الصالحات

وعليكم السلام تفضل اخى الكريم لك ما طلبت موعد استحقاق الايجار.xlsx

عليك بإكمال المشاركة كوضع البرامج فى روابط مباشرة وسهلة كما عليك توضيح اسم المستخدم وكلمة السر

بارك الله فيكم جميعا وجزاكم الله كل خير والحمد لله الذى بنعمته تتم الصالحات

تفضل هذا بالكود وبكل الشروط واسرع بكثير فلترة بعدة شروط.xlsm

تفضل جعفر 260.الشبكة الإستدلالية للمرتبات.accdb.zip

تفضل والكود: Function check_both_combos() 'No work without Sinf If Len(Me.cmb_sinf & "") = 0 Then MsgBox "Please select a Sinf" Me.cmb_sinf.SetFocus Exit Function End If If Len(Me.cmb_daraja & "") = 0 Then 'Only Sinf is selected Me.Sinf_Est = DLookup("[rakm istid]", "khibra", "[sinf]=" & Me.cmb_sinf) Me.Daraja_Est = "" Else 'both Sinf and Daraja are selected Me.Sinf_Est = DLookup("[rakm istid]", "khibra", "[sinf]=" & Me.cmb_sinf) Me.Daraja_Est = DLookup("[istidlal]", "khibra", "[sinf]=" & Me.cmb_sinf & " And [daraja]=" & Me.cmb_daraja) End If End Function Private Sub cmb_daraja_AfterUpdate() Call check_both_combos End Sub Private Sub cmb_sinf_AfterUpdate() Call check_both_combos End Sub Private Sub cmb_sinf_DblClick(Cancel As Integer) Me.cmb_sinf = "" Call check_both_combos End Sub Private Sub cmb_daraja_DblClick(Cancel As Integer) Me.cmb_daraja = "" Call check_both_combos End Sub جعفر 260.الشبكة الإستدلالية للمرتبات.accdb.zip

السلام عليكم إنشاء pivot table نطاقات الدمج المتعددة.rar http://office.microsoft.com/client/helppreview.aspx?AssetId=HA102265859990&lcid=1025&NS=EXCEL&Version=12&CTT=5&origin=HP010095249 المطلوب غير واضح في أمان الله

اخوتي الافاضل من منطلق الواجب بشكر الناس ( فمن لا يشكر الناس لا يشكر الله ) اتقدم بعميق الشكر و الامتنان لهذا المنتدى الطيب و لأساتذته وطلاب العلم فيه ، فهذه صفحة مفتوحة لشكر كل العمالقة و الاساتذة وطلاب العلم و كل من حاول وحقق نجاحا بسيطا أو كبيرا ... لكل من القى في هذا البحر كلمة انتفع منها طالب علم أو عالم عملاق . اجول في منتداكم اتعلم و اعمق ما لدي و اسمع و اتعلم واحمل برامج و افكار استمتع بها كما يستمتع باي شيئ جميل ، وحان الوقت - ربما - لاساهم قليلا بما علمني ربي . هذا جزء من نظام تخليص جمركي عامل في مؤسستي منذ عامين خضع لكثير من التعديلات ، و اخر هذه التعديلات لوحة الرقابة المرفقة لتدقيق المعلومات وصيانتها حال وجود خطأ من احد المستخدمين ، وآسفا اضطررت لازالة كثير من المحتويات لاصل لحجم مناسب يمكن تنزيله مع الحفاظ على سرية معلومات عملائي ، فكل المعلومات وهمية رغم قلتها فهي متكاملة لتشغيل النظام . هذه زكاة ... ما علمني ربي اتمنى منكم النصيحة و التشجيع و التواصل اخوكم نارت لبزو ( ابو آدم) SuperImp1.rar