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

ضع هذا الكود تحت الزر ..... Me.ID.SetFocus DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO فرعى ( ID, [كود الصنف], [اسم الصنف], المورد, [سعر البيع], اللون, المقاس ) SELECT الأصناف.ID, الأصناف.[كود الصنف], الأصناف.[اسم الصنف], الأصناف.المورد, الأصناف.[سعر البيع], الأصناف.اللون, الأصناف.المقاس FROM الأصناف WHERE (((الأصناف.ID)=[forms]![frmsrch]![ID]));" DoCmd.RunSQL "DELETE الأصناف.ID, الأصناف.[كود الصنف], الأصناف.[اسم الصنف], الأصناف.المورد, الأصناف.[سعر البيع], الأصناف.اللون, الأصناف.المقاس FROM الأصناف WHERE (((الأصناف.ID)=[forms]![frmsrch]![ID]));" DoCmd.SetWarnings True Me.Requery

طيب ضع الفانك هذا في وحدة نمطية Function Seperate_Digits(T As String) As String Dim i As Integer Dim C As String Dim Which_Letter As String If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) C = Asc(Mid(T, i, 1)) Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) Case 47 Which_Letter = "" End Select Next i Seperate_Digits = Which_Letter End Function ثم ضع الكود التاليى تحت حدث الزر On Error Resume Next Dim s As String, x As Integer s = "GRN" x = Seperate_Digits(Me!FATORA_NO) Me!FATORA_NO = Format(s & Str(x) + 1, "000") وافينا بالنتيجة

حياك تشرفنا ......🌺

انظر الاستعلام النهائي .... 3733 (1).accdb

تحت حدث عند الضغط على الزر لديك ضع هذا الكود 'Me.[FATORA_NO] = [FATORA_NO] + 1 On Error Resume Next DoCmd.RunCommand acCmdRecordsGoToNew Dim s As String, x As Integer s = "GRN" x = DCount("*", "101") + 1 Me!FATORA_NO = Format(s & Str(x), "000")

منور استاذ احمد فينك لك وحشة .... عساك بصحة وعافية

مشاركه مع اخى واستاذى @kanory جزاه الله خيرا حاجه كده على قد حالى dl = Nz(DMax("FATORA_NO", "101"), 0) rd = Int(Right([dl], 2)) + 1 strLeft = Left(dl, 3) Me.[FATORA_NO] = strLeft & Format(rd, "00") Me.Refresh تقبلوا تحياتى وتمنياتى بالتوفيق 3733.accdb

مش تفكير بس ... فنجان قهوة .. بارك الله فيك .. بالتوفيق

انشئ قاعدة جديدة وصمم نموذج وبه زر وضع تحت حدث عندالنقر على الزر هذا الكود ..... Dim objAcc As Access.Application Set objAcc = GetObject("C:\Users\ACER\Desktop\data1.accdb") objAcc.DoCmd.OpenQuery "Qre1" objAcc.Application.Quit Set objAcc = Nothing

نرحب بالأخ صالح البريكان (أبو آمنة) فى فريق الموقع🌼 أهلا وسهلا بك أخي الكريم ، و تقبل الله جهودك و جهود باقي الأخوة فى نشر العلم و المعرفة

آمل أن لا يكون في مشاركتي مخالفة .. وأعتذر مقدما ولكم كل الحق في حذفها. وجدت هذا الموضوع ربما يكون فيه الحل المطلوب. موضوع لمفرج .. فكرة تحجيم الحقل

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

ده نورك اخى العزيز ربنا يعزك وكذلك انتم وحشنى اخى بس بعتب عليك بمنداتى استاذ فاننى اخوكم الصغير وطالب علم اتعلم منكم اخوانى واساتذتى شويه ضغط فالشغل الفتره اللى فاتت والحمد لله خف الضغط شويه اسال الله ان يديم بيننا الموده والحب فالله

نفس الكود السابق انسخة ثم الصقه ثم غير اسم الكود ثم علامة + الوحيدة الموجودة في الكود استبدلها الى - ثم اربط الكود بزر الفاتورة للبيع .... مرفق ملف المخزنAZ02.xlsm

السلام علكم شكرا لك استاذ @د.كاف يار شكرا لك استاذ@ازهر عبد العزيز شكرا لك استاذ @husamwahab بارك الله فيكم اجمعين

تفضل اخي العزيز ارجو ان يكون طلبك ملاحظة : 1- كود التسلسل منقول من احد المواقع الاجنبية 2- اخي العزيز مراعاة تسمية العناصر في النموذج فلا يجوز التسمية ب Name or Date فهي كلمات محجوزة تجربة_(2).rar

تفضل لك ما طلبت .. تم عمل كل المطلوب من فصل للقروش عن الجنيهات وتم عمل وتصميم معادلة الإستقطاعات وتطبيق كل هذا على الجداول 1حصر تالف.xlsx

هذا الكود يدرج لك القوائم المنسدلة Option Explicit Sub data_val() Dim Fatura As Worksheet, Price As Worksheet Dim Dic As Object Dim lr%, i% Set Fatura = Sheets("فواتير") Set Price = Sheets("الأسعار") Set Dic = CreateObject("Scripting.Dictionary") lr = Price.Cells(Rows.Count, 1).End(3).Row i = 2 With Price Do Until i > lr If .Cells(i, 1) <> vbNullString Then Dic(.Cells(i, 1).Value) = vbNullString End If i = i + 1 Loop End With With Fatura.Cells(5, 1).Resize(15).Validation .Delete .Add 3, Formula1:=Join(Dic.keys, ",") End With End Sub الملف مرفق samihkhader.xlsm

تسلم أستاذي العزيز ماقصرت جزاك الله كل خير 🌸

بارك الله فيك استاذ احمدزمان اشكرك كود شغال وممتاز ربي يحفظك عن أبي هريرة رضي الله عنه أن النبي صلى الله عليه وسلم قال: «لا يَشْكُرُ اللَّهَ مَنْ لا يَشْكُرُ النَّاسَ» أحمد يوسف كان لدي مشكلة في ضعف انترنيت لم استطع تحميل الا محاولات عديدة تم تحميل ملف ل ارى

استبدل في المعادلات الرقم 100 بأي رقم تربده

أخي نحن هنا نتبادل المعرفة فكلنا يجود بما لديه من علم ووقت وليس هذا حكرا علي أحد دون الآخر فلا تعتذر عن مشاركة بل ونرجو منك مزيدا من المشاركات فلعل معلومة تشارك بها هنا لا تلقي لها بالا! ينتفع بها مئات بل آلاف ممن يدعون لك بخير يكتب لك أجرها الي أن يشاء الله. أخي لا توجد هنا مشاركة ممنوعة الا ما خالف القواعد العامة المنظمة للمنتدي طالما بها فائدة عامة للجميع ولم تخالف شرعا أو لوائح المنتدي. ولعل أساتذتي يوافقوني الرأي تمنياتي بالتوفيق والسداد وجزاك الله خيرا

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

آسف لتأخري بالرد نظرا لانشغالي اطلعت علي مرفقك ماشاء الله تبارك الله تصميم جميل وأفكار جميلة ولكن هذه الصور الكثيرة ستعمل علي زيادة حجم البرنامج بشكل مبالغ فيه مما يسبب مشكلات بالغة علي المدي الطويل لذي انصحك بأن تجعل هذه الصور مرتبطة وليست منضمة (Linked not Embedded) وأن تجعل الصور بمجلد البرنامج هذا سيعمل علي تقليل حجم قاعدة برنامجك وتسريع تحميله. واليك هذا الرابط لتوضيح الفكرة أكثر. قمت بتعديل خاصية اغلاق الحقل المعدل بمرفقك (بعد أن قمت بعمل ضغط واصلاح له وستري الفارق في الحجم بنفسك) أما عن النقطة 4 بمشاركتي السابقة فلم أجد وقتا كافيا لتنفيذها علي مرفقك ولكن سأضع لك كود اضافة بيانات أي نموذج مهما كان عدد عناصر التحكم به الي أي جدول بشرط ان تكون أسماء الحقول بالجدول مساوية لاسماء عناصر التحكم علي النموذج حتي يستطيع الكود أن يرسل البيان الصحيح بالمكان الصحيح بالجدول سأترك لك العمل علي هذه النقطة وهذا هو الكود ولا تنسي الشرط... Option Compare Database Dim m As Recordset Dim C As Control Sub Add_New(Frm As Form, tbl As String) On Error Resume Next Set m = CurrentDb.OpenRecordset(tbl, dbOpenDynaset, dbSeeChanges) m.AddNew For Each C In Frm.Controls If C.ControlType = acTextBox Or C.ControlType = acComboBox Then m(C.Name) = C.Value End If Next m.Update m.Close Set m = Nothing msgbox "Done!" كل ما عليك هو وضع هذا الكود في موديول ثم تستدعيه من أي نموذج تريده هكذا Call Add_New(me,"your tabel name") تمنياتي بالتوفيق هذا مرفقك بعد التعديل (والضغط) CashierV2.accdb

السلام عليكم و رحمة الله وبركاته اخي الفاضل تم عمل الكود في حدث التغيير في الورقة لذلك فقط بمجرد كتابة رقم القائمة في الخلية الصفراء تظهر النتائج فورا Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$I$3" Then Q1 = Range(Target.Address).Value Range("B15:J39").ClearContents TR = 15 With Sheets("ÊÝÇÕíá ÇáãÈíÚÇÊ") For FR = 4 To 999 If .Cells(FR, 2) = Q1 Then Cells(8, 4) = .Cells(FR, 3) Cells(TR, 2) = .Cells(FR, 1) Cells(TR, 3) = .Cells(FR, 4) Cells(TR, 4) = .Cells(FR, 5) Cells(TR, 5) = .Cells(FR, 6) Cells(TR, 7) = .Cells(FR, 8) Cells(TR, 8) = .Cells(FR, 9) Cells(TR, 9) = .Cells(FR, 10) Cells(TR, 10) = .Cells(FR, 11) Cells(12, 9) = .Cells(FR, 12) Cells(10, 9) = .Cells(FR, 14) Cells(10, 4) = .Cells(FR, 15) Cells(12, 4) = .Cells(FR, 16) TR = TR + 1 End If Next FR End With Range(Target.Address).Select End If End Sub مرفق الملف ahmed1.xlsm

اخي الكريم من وجهة نظري اختيارك لقاعدة بيانات SQL Server فهي افضل اختيار لأمن و حماية البيانت اما التقارير فأنصحك بتقارير الكرستال او تقارير الفيجوال اما الواجهات في بأي لغة دائما افضل بأن تكون باللغة التي تتقنها لكي تسهل التعامل بها من قبلك كمبرمج فالأقرب الى الاكسس هي VB و C#

يا سيدي الفاضل هذا مفهوم ولكن وضح تشعله على اي ورقة في ملفك اكثر من 5 اوراق و لم اجد اي ورقة غاتورة او توريد انته مش راضي تفهمني ختى ايش الي تبغاه بس شعل الكود على ملفي طيب اشغله يعمل ايه ياخذ بيانات من فين و يخطها فين ان غهم السؤال نصف الاجابه و الملف الى انته خاطه انا مش فاهم منه حاجه فاذا توضح طلبك بالظبط و ترتب الملف بشكل يمكن التعامل معاه حينها انا خدامك يا معلم تخياتي

الشكر لله اخى حسين اما لماذا توقف عند الرقم 100 فهذا لان السطر الثانى من الكود لقطع اول رقمين يمكنك زياده الفورمات للاصفار لاربعه كما الكود التالى وزياده القطع فالسطر الثانى dl = Nz(DMax("FATORA_NO", "101"), 0) rd = Int(Right([dl], 4)) + 1 strLeft = Left(dl, 3) Me.[FATORA_NO] = strLeft & Format(rd, "0000") Me.Refresh ويمكنك استبدال الكود والاستغناء عن الفورمات كالتالى dl = Nz(DMax("FATORA_NO", "101"), 0) rd = Int(Right([dl], Len(dl) - 3)) + 1 strLeft = Left(dl, 3) Me.[FATORA_NO] = strLeft & rd Me.Refresh بالتوفيق

بعد إذن الخبير husamwahab المحترم تم تعديل النموذج لحساب القيمة وتجميعها تحياتى حذف الزر جيد-2.accdb

تسلم الشرف لى اخى 💐

اصبر اخى الكريم فعليك الإقتناع بأن الموضوع كبير جداً وليس سهل او هين _ فهى أكواد كثيرة وان كان الأمر بالسهل او الهين لقمت انت بحله بنفسك وليس هناك احتياج لرفعه هنا !!!!!

مرفق ملف اخر يمنع اضافة اعمدة او صفوف ويمنع ايضاً حذفها كبفية عمل ذلك اتركها مؤقتاً "فزورة" ربما يكتشفها البعض Privent_New_Cols_Rows.xlsx

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

تفضل اخي العزيز ارجو ان يكون طلبك تم التعديل بطريقة ارجو ان لا تسبب لك مشكلة حذف الزر جيد-2.rar

جرب هذا الملف بمنع ادراج صفوف او أعمدة (سأفكر بطريفة لمنع حذف صفوف او أعمدة) و حاول ان تعرف السر No_New_Cols_Rows.xlsx

من رخصة استاذ حسام تفضل على طريقتي انشأت نموذج وسميته Filter وبدوره تستطيع فلترة اي محافظة وطباعة الناتج بتقرير DB2.rar

مشاركة مع اساتذتي الاجلاء تفضل التعديل ارجو ان يكون طلبك test (3).rar

تفضل التعديل اخي الكريم test (2).accdb

xlast = DMax("fatoraid", "tblfatora", "left(fatoraid, 2) = myfatoratype()") انت بتستدعي اكبر رقم في قاعدة البيانات و ثم تقوم بإضافة رقم +1 الى المجموع بعد تقسيم الرقم xnext = Val(Mid(xlast, 3, 5)) + 1 و في الأخير بتضبط تنسيق الأرقام Me.FatoraId = prtyr & Format(xnext, "00000") لكن يبقى موضوعك مبهم لم تذكر ما ذا تريد

السلام عليكم ورحمة الله اجعل هذا الكود هكذا Sub KH_Paste(MySheet As Worksheet, KRow As Integer) On Error Resume Next With MySheet .Range("A" & KRow).PasteSpecial xlPasteValues .Range("A" & KRow).PasteSpecial xlPasteFormats If .Name = "ناجحين" Then .Range("A" & KRow) = KRow - 9 Else .Range("A" & KRow) = KRow / 2 - 4 End If End With Application.CutCopyMode = False End Sub كشف درجات الصف الثاني الابتدائي_5.xls

و عليكم السلام و رحمة الله وبركاته جرب توريد للمخزن في المرفق لعله المطلوب Sub ADDIN01() Dim FS As Worksheet, TS As Worksheet Dim Q1 Set FS = Sheets(ActiveSheet.Name) Set TS = Sheets("المخزن") For FR = 5 To 30 Q1 = FS.Cells(FR, 6).Value Q2 = FS.Cells(FR, 4) & "*" & FS.Cells(FR, 5) Q3 = FS.Cells(FR, 7).Value For TR = 3 To 999 If TS.Cells(TR, 2) = Q1 Then For TC = 3 To 33 If TS.Cells(2, TC) = Q2 Then TS.Cells(TR, TC) = TS.Cells(TR, TC) + Q3 GoTo 9 End If Next 'TC End If Next 'TR 9 Next ' FR End Sub المخزنAZ.xlsm

تفضل هذا العديل Dim strDbFile, strConnect As String strDbFile = "مسار قاعدة البيانات" strConnect = "MS Access;DATABASE=" & strDbFile Dim tdf As DAO.TableDef Dim db As DAO.Database Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then tdf.Connect = strConnect tdf.RefreshLink End If Next

هذا واجب علينا للمنتدى واعضائه حياك الله اخي الكريم

جرب المرفق وخبرنا بالنتيجة ..... fouad.accdb

طيب على اي اساس تريد حذف السجل المكرر ... هل اول سجل يحذف والاخر يبقى ... لانك تقول البيانات الاخرى مختلفة مثلا محمد البرناوي لديه سجلات عديدة وحقل الهاتف لدية رقم هاتف رقم ١ وفي السجل الاخر رقم هاتف اخر رقم ٢ ؟؟؟؟ كيف يتم الحذف ... ماهو الاساس .... ام تريد سجل واحد بغض النظر الى تلك الحقول الاخرى ؟؟

تفضل Dim fdialog As Office.FileDialog Dim filepath As String Set fdialog = Application.FileDialog(msoFileDialogFilePicker) With fdialog .Title = "Select image" .AllowMultiSelect = False .Filters.Clear .Filters.Add "Image file", "*.jpg ; *.bmp ; *.png" If .Show Then filepath = .SelectedItems(1) [Imagepath] = filepath Else Exit Sub End If End With

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

اخي الكريم السبب هو خطأ في كلمة المرور لقاعدة البيانات اذ لم تكن تقاعدة البيانات محمية بكلمة مرور فقط ضع كومتين "" بدون مسافات بينهم الواضح في الكود لديك هو انك وضعت مسافية بين الكومتين شكرا لك اخي الكريم على هذه الكلمات الجميلة فعلا يمكن وضعه في ازرار و يمكن كذلك وضعه في حدث عند فتح النموذج الرئيسي فهو افضل

السلام عليكم ورحمة اله تعالى وبركاته أما بعد .. استكمالاً لمشاركتي في الموضوع السابق اضع بين ايديكم البرنامج + ملف توليد السيريال .. واعتذر على التأخير ملاحظة : جميع البيانات في الجدول يمكن تشفيرها كلاً حسب طريقته لذلك تركتها بدون تشفير لكي تتضح طريقة عمل البرنامج اتمنى ان ينال اعجابكم تحياتي count-sec.mdb registration_key.mdb

قريبا ان شاء الله مع الشرح = = = = = = = ‏الثلاثاء‏ 21‏/11‏/1432هـ الموافق ‏18‏/10‏/2011م نظام المستوعات و متابعة المخزون الفكرة من اعداد اخي اسامة العضو في هذا المنتدى هو نظام اكسل يهدف لحساب حركة المخزون لعدد 4 عمليات وهي (استلام + صرف + ارجاع + شطب) المميزات و الخصائص 1. يمكن تسجيل عدة مستخدمين للملف تصل الى 11 مستخدم 2. يمكن تسجيل اضناف او مواد حتى 9000 صنف او مادة 3. قائمة المواد المخزنة مع ملخص بياناتها 4. كل الحركات المسجلة للمواد 5. نموذج خاص لإضافة أي مواد جديدة 6. نموذج للبحث في قائمة المواد 7. البحث خلال فترة محددة عن أي مادة اسماء المستخدمين وكلمات المرور الحالية هي: Admin = 123 موظف 2 = 22 Super_Stores.rar