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

.هذه طريقة اخرى بدون كتابة اسماء الحقول وخاصة عندما تكون كثيرة ولكن بشرط ان تتشابه ترتيب الحقول في الجدولين Dim db As DAO.Database Dim rstFrom As Recordset Dim rstTo As Recordset Set db = CurrentDb Dim RC, i, r As Integer Set rstTo = db.OpenRecordset("tblB1", dbOpenDynaset) Set rstFrom = db.OpenRecordset("tblB", dbOpenDynaset) rstFrom.MoveFirst: rstFrom.MoveLast RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC rstTo.AddNew For r = 1 To rstFrom.Fields.Count - 1 rstTo.Fields(r) = rstFrom.Fields(r) Next r rstTo.Update rstFrom.MoveNext Next i rstTo.Close rstFrom.Close Set rstTo = Nothing Set rstFrom = Nothing Set db = Nothing Kan_355.accdb

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

تفضل هذه المحاولة استاذ حسين العربى ارجو ان تكون موفقة الارشيف شئون الموظفين-100.rar

تفضل هذا التعديل من قبلي اخي الكريم صورة من الجهاز او الاسكانر سيتم انشاء فولدر تلقائيا يمكن التعديل على الكود لتغيير مسار انشاء الفولدر الارشيف شئون الموظفين.accdb

Try This Macro Option Explicit Sub Colorize_Comments() Const CLR = 35 With Range("A1").CurrentRegion .Interior.ColorIndex = xlNone .SpecialCells(1).Interior.ColorIndex = CLR End With End Sub

حياك الله وبالتوفيق ,,,,,

تفضل ---------->>>>>> New تطبيق Microsoft Office Access.mdb

Try This New File Salim_book.xlsm

عليكم السلام Private Sub endpage_Click() strSql = "SELECT * FROM tblData WHERE tblData.ID > ( (select COUNT(*) from tblData) - 10)" Me.RecordSource = strSql End Sub Private Sub firstpage_Click() strSql = "SELECT TOP 10 tblData.ID, tblData.[NO], tblData.Locatin, tblData.SecName, tblData.DepName, tblData.RegDate FROM tblData WHERE (((tblData.ID)>=1))" Me.RecordSource = strSql End Sub السجلات في النموذج .mdb

وعليكم السلام- استبدل معادلتك الشرطية بهذه المعادلة =IF(AND($C6<>"",$C6<>0),CHOOSE($C6,"-","-","15","45","85","125","165"),"") أما بالنسبة للصفحة التى لا تحتوى على هذه المعادلة الشرطية (P 41 - Monolo) فيمكنك جعل تنسيق الخلايا بها كما بالصورة ... وشكراً 1 Drivers Over Time Summary1.xlsx

مشاركة مع استاذ @husamwahab اتفضل اليك كلتا الطريقين تقدر تستخدم طريقة ان لا يظهر نوع العملة اللي تدخل في حقل تحويل من في مصدر تحويل الى او تقدر تستخدم هذا الكود قبل تحديث للحقل تحويل من و تحويل الى Private Sub تحويل_الى_BeforeUpdate(Cancel As Integer) If Len(Me.تحويل_من & "") <> 0 And Me.تحويل_من = Me.تحويل_الى Then MsgBox "لا يجوز ادخال نفس نوع العملة في الحقل تحويل من و تحويل الى " Cancel = True End If End Sub Private Sub تحويل_من_BeforeUpdate(Cancel As Integer) If Len(Me.تحويل_من & "") <> 0 And Me.تحويل_من = Me.تحويل_الى Then MsgBox "لا يجوز ادخال نفس نوع العملة في الحقل تحويل من و تحويل الى " Cancel = True End If End Sub استخدمت كلتا طريقين في مرفقك 1.zip

بالخدمة استاذ أبو يحيى الجبلاوي تصميم صندوق-2.rar

عليكم السلام استاذ أبو يحيى الجبلاوي تفضل هذا المثال ارجو ان ينفعك الفكرة عند اختيار عملة من المربع الاول تختفي من المربع الثاني وبذلك نضمن عدم التكرار Root1122.rar

تمت معالجة الأمر Issa.xlsx

محاولة ارجو ان تكون موفقة ملاحظة: الحل مبني على المشاركة ادناه مع بعض التعديل https://www.officena.net/ib/topic/105776-تعديل-علي-كود-اضافة-صورة-لموظف/ Desktop.rar

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

استخدم دالة DLookup مع شرط كودالصنف في الاستعلام يساوي كود الصنف في النموذج المبيعات

اذا كان ايام الحضور 26يوما في شهر قم بعمل الاتي ايام الغياب يساوي 26 ناقص ايام الحضور اي 26 - عدد ايام الحضور في الشهر او اذا هناك شيء اخر تبحثه وضحه سؤالك اكثر تحياتي

Sub test() With Sheets("الجمعة") a = .Range("b3:c" & .Cells(Rows.Count, 3).End(xlUp).Row - 2) ReDim b(1 To 1) l = 1 For i = 1 To UBound(a) If a(i, 1) <> 0 Then b(l) = a(i, 2) l = l + 1 End If ReDim Preserve b(1 To l) Next With Sheets("re") Cells(12, 2).Resize(UBound(b) - 1) = Application.Transpose(b) End With End With End Sub

الكود يضيف كل السجلات الموجود في الجدول وذلك عن طريق الكود التالي RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC هذا الكود الذي انت وضعت جزءا منه لا يضيف كل الحقول الا اذا كتبت وحددت له الحقول بالشكل التالي rs.AddNew السطر التالي يعبر عن الحقل ..... قم بتكرار السطر بعدد الحقول الموجودة لديك rstTo!codhesab = rstFrom!codhesab rstTo!الحقل الثاني = rstFrom!الحقل الثاني وهكذا rs.Update أرفق لنا الجدولين وبه بيانات تجريبية للتطبيق

تفضل .... Dim db As DAO.Database Dim rstFrom As Recordset Dim rstTo As Recordset Set db = CurrentDb Dim RC, i As Integer Set rstTo = db.OpenRecordset("table2", dbOpenDynaset) Set rstFrom = db.OpenRecordset("table1", dbOpenDynaset) RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC rs.AddNew rstTo!codhesab = rstFrom!codhesab rs.Update rstFrom.MoveNext Next i rstTo.Close rstFrom.Close Set rstTo = Nothing Set rstFrom = Nothing Set db = Nothing

اخي العزيز الملف الذي أرسلته شغال 100٪ كما طلبت انت بالضبط دون زيادة او نقصان مرفق الملف مرة أخرى مع صور توضيحية TEST-1.rar

تفضل التعديل ان شاء الله يكون طلبك ملاحظة: اذا حاولت اضافة صورة قبل اضافة رقم الموظف تظهر رسالة تنبهك لضرورة إدخال رقم الموظف اولاً. اقترح تخليه ترقيم تلقائي وتخلص TEST.rar

تفضلي التعديل حسب فهمي لطلبك Root2013.rar

تفضلي التعديل ارجو ان يكون طلبك Root2012.rar

وعليكم السلام-تفضلى goto the page with pass1.xls

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

جرب المرفق Sub serchsheet() Dim sh As Worksheet Dim rng As Range Set rng = Sheets("ÊÚÏíá_ÓÚÑ_ÇáÚãíá").Range("G2") Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Name = rng.Text Then sh.Visible = True sh.Activate Exit For End If Next sh Application.ScreenUpdating = True End Sub الفاتورة الرئيسية.xlsm

السلام عليكم هذه محاولة ارجو ان تكون طلبك ملاحظة : الفكرة مستوحاة من كود للاستاذة زهرة (ترقيم تلقائي في استعلام) Root-data.rar

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد... المصنف2 (1).xlsm

السلام عليكم أقدم لكم برنامج لإدارة المشتريات والمبيعات والمخازن لعله ينال إعجابكم برنامج لإدارة المشتريات والمبيعات والمخازن.xls