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

حسب فهمي لطلبك انظر التعديل ، اذا يحقق طلبك .. وإلا اشرح مطلوبك بتفصيل اكثر help2.rar

in the Cell I3 this formula,and drag 3 columns to right,Until Row 121 =VLOOKUP($H3,'Data base'!$B$4:$E$69,COLUMNS($A$1:B1),0) File Included mr7mix.xlsx

الاخوة الكرام أولاً : كل عام و انتم بخير برجاء مساعدتي في برنامج الفواتير المرفق حيث اني ارغب في ان يتم اضافة رقم تلقائي في حقل رقم الفاتورة يتكون من الرقم المرجعي + تاريخ الفاتورة ( العام فقط ) 21001 ليكون كالتالي ارقم المرجعي ( 001 ) + العام ( 21) ويتم حفظ الرقم الجديد في الجدول ولكم كل تقديري وشكري INVOICES.rar

شاشة login اكسس

شكرا جزيلا إخوتي الكرام لقد وجدت الأداة المناسبة في هذا الرابط https://answers.microsoft.com/en-us/windows/forum/windows_10-files/missing-file-mscomm32ocx/996447c3-3c1d-4d81-ac58-aa8284c5ed82

جرب وأخبرني النتيجة D (1).accdb

تفضل تم حماية حقل الترقيم التلقائي غيرت اسم الجدول وعدلت على الفواصل بين اسماء الحقول الى الطريقة الصحيحة كل هذا من اجل تتمكن من قراءة وفهم الجمل البرمجية Dim rs As Recordset Dim strSQL As String Dim i As Long strSQL = "SELECT Max(CLng(Right([ID_exp_all],Len([ID_exp_all])-1))) AS xc FROM saderat " Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot) If rs.RecordCount > 0 Then rs.MoveFirst On Error Resume Next i = rs![xc] Me.ID_exp_all = "A" & i + 1 End If rs.Close Set rs = Nothing ترقيم خاص بالاقسام2.rar

تفضل جرب وأخبرني النتيجة، للمعلومة الحقل kwe ان لم تستخدمه في أي شي فلماذا قمت بوضعه؟ تاريخ.accdb

عليكم السلام ورحمة الله وبركاته، تفضل جرب وأخبرني النتيجة. Private Sub x1_AfterUpdate() 'c0ded bY: SEMO.Pa3x '------------------- Dim ftPosition As String ftPosition = x1.Column(3) 'set value from combobox to textbox xt = ftPosition End Sub D.accdb

عليكم السلام، حيالله أهل البصرة. تصفحي هذا الموضوع، وستجدين فيه طلبك. باسورد الدخول لليوزرات = 313

وهل من المفروض على من سيقوم بالمساعدة ان ينشأ لك ملفاً بما تريد؟ ام عليك رفع الملف بنفسك على كل حال اليك هذا النموذج يحتوي على 2 ماكرو واحد للقوائم المنسدلة والاحر لادراج الاسماء 10 : 10 الماكرو ديناميكي (اي انه يحصي كل الاسماء مهما كان عددها) (كل مجموعة مرتية ابجدياُ) Option Explicit Sub Get_data_val() Const t = 10 Dim obj As Object Dim lr%, i%, m%, k%, Cnt% Dim arr Dim My_rg As Range If ActiveSheet.Name <> "Sheet1" Then Exit Sub k = 3 lr = Cells(Rows.Count, 1).End(3).Row Set obj = CreateObject("System.Collections.Arraylist") For i = 2 To lr Step t Set My_rg = Cells(i, 1).Resize(t) Cnt = Application.CountA(My_rg) Set My_rg = My_rg.Cells(1, 1).Resize(Cnt) Do Until m = Cnt obj.Add My_rg.Cells(m + 1, 1).Value m = m + 1 Loop If obj.Count Then obj.Sort With Cells(2, k).Validation .Delete .Add 3, Formula1:=Join(obj.Toarray, ",") Cells(2, k) = obj(0) End With End If k = k + 1: m = 0 obj.Clear Next i End Sub '++++++++++++++++++++++++++++++++++ Sub Get_By_10() Const t = 10 Dim obj As Object Dim lr%, i%, m%, k%, Cnt% Dim My_rg As Range If ActiveSheet.Name <> "Sheet1" Then Exit Sub k = 3 lr = Cells(Rows.Count, 1).End(3).Row Set obj = CreateObject("System.Collections.Arraylist") Cells(5, 3).CurrentRegion.Offset(1).ClearContents For i = 2 To lr Step t Set My_rg = Cells(i, 1).Resize(t) Cnt = Application.CountA(My_rg) Set My_rg = My_rg.Cells(1, 1).Resize(Cnt) Do Until m = Cnt obj.Add My_rg.Cells(m + 1, 1).Value m = m + 1 Loop If obj.Count Then obj.Sort Cells(5, k).Resize(obj.Count) = _ Application.Transpose(obj.Toarray) End If k = k + 1: m = 0 obj.Clear Next i End Sub الملف مرفق Kaissi.xlsm

السلام عليكم استاذي الحبيب abouelhassan اعتذر لتاخري بالرد بالنسبة للمشكلة اعلاه السبب انك لم تقم بانشاء علاقة بين جدولي المواد والصفحات 2300-1.rar

اسف جدا على التاخير لوجود عطل في حاسبتي ..تقوم بعمل استعلام لتحديث الحقل REF_INVOICE..يمكنك الاستفادة من المثال المرفق INVOICE.mdb

جدول الصادر يحتوي على حقل باسم رقم عام وآخر برقم الصادر وجدول الوارد كذلك مثله في اي حقل من هذه الحقول تريد هذا الترقيم ؟

ووالديك اخي العزيز حسام وكافة اخواننا الكرام 🌹

حل آخر في الملف المرفق... tarif.xls

لا افهم كيف بامكان خلية واحدة ان تظهر نتيجة اكثر من معادلة واحدة المعادلات المطلوبة في العامود N Nassim.xls

اثراء للموضوع بعدم عمل حماية Private Sub Worksheet_Change(ByVal Target As Range) Dim TT As Range Set TT = Range("A1") Set TT = Intersect(TT, Target) If Not TT Is Nothing Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox " .ليس لديك صلاحية بتغيير قيمة الخلية " End If End Sub منع تغيير قيمة خلية .xlsm

هذه تجربة بحت من خلال فورم بنك.xlsm

اخواني الكرام اضع بين ايديكم الجزء الاول من شرح الترحيل وبإنتظار تعليقاتكم واستفسارتكم ابواحمد الجزء الاول من الشرح ملف شرح الجزء الاول الترحيل.rar الجزء الثاني من الشرح ملف شرح الجزء الثانى الترحيل2.rar الجزء الثالث من الشرح (ترحيل القيم - ترحيل محدوود) ملف شرح الجزء الثالث الترحيل3.rar الجزء الرابع من شروحات الترحيل ملف شرح الجزء الرابع ترحيل حسب اسم الشيت.rar لا تنسوني أخوتي من الدعاء لي بظهر الغيب

اخي محمد شكراً لك ان شاء الله وفي الجزء الثاني ما طلبت اخي رضا شكراً لمرورك