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

تفضل ضعه في حدث النقر على الزر On Error Resume Next Dim i As Integer Dim ii As Long Dim rs1, rs2 As dao.Recordset Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM TAB WHERE TAB.TYPE1=1") Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM TAB WHERE TAB.TYPE1>1") rs1.MoveLast: rs1.MoveFirst For i = 0 To 10000 Step 0 i = i + 1 rs1.Edit rs1!MNO = i rs1.Update rs1.MoveNext Next i rs2.MoveLast: rs2.MoveFirst ii = 10000 For ii = 10000 To 100000 Step 0 ii = ii + 1 rs2.Edit rs2!MNO = ii rs2.Update rs2.MoveNext Next ii Set rs1 = Nothing Set rs2 = Nothing

في هذه الجزئية عوض الأرقام في الكود 10000 بـ 20000 فقط،

وعليكم السلام استاذ @ازهر عبد العزيز مجرد فكره ربما تنفعك بالتوفيق qm.accdb

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

بارك الله فيك أخانا الحبيب.

تفضل أخي الحبيب، هذا هو الماكرو: Sub RemoveFirstSpaces() Dim i As Paragraph, n As Long For Each i In ActiveDocument.Paragraphs For n = 1 To i.Range.Characters.Count If i.Range.Characters(1).Text = " " Or i.Range.Characters(1).Text = "؟" Or i.Range.Characters(1).Text = Chr(9) Then i.Range.Characters(1).Delete Else: Exit For End If Next n Next End Sub

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

تعديل بسيط ان شاء الله يكون هو المتقن والمعتمد On Error Resume Next Dim i As Integer Dim ii, j As Long Dim rs1, rs2 As Dao.Recordset Set rs1 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 =1 ORDER BY TAB.TNO") Set rs2 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 >1 ORDER BY TAB.TNO") rs1.MoveLast: rs1.MoveFirst For i = 0 To rs1.RecordCount Step 0 i = i + 1 rs1.Edit rs1!MNO = i rs1.Update rs1.MoveNext Next i rs2.MoveLast: rs2.MoveFirst ii = 10000 For ii = 10000 To (rs2.RecordCount + ii) Step 0 ii = ii + 1 rs2.Edit rs2!MNO = ii rs2.Update rs2.MoveNext Next ii Set rs1 = Nothing Set rs2 = Nothing

أخي العزيز أبو عاصم، في ملفك السابق جربت وضع مسافات زائدة بداية كل صف ثم استخدمت من إضافة البيان أمر (حذف المسافات الزائدة بداية الفقرات) فتمت العملية بنجاح.

هكذا افضل On Error Resume Next Dim i As Integer Dim ii As Long Dim rs1, rs2 As Dao.Recordset Set rs1 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 =1 ORDER BY TAB.TNO") Set rs2 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 >1 ORDER BY TAB.TNO") rs1.MoveLast: rs1.MoveFirst For i = 0 To rs1.RecordCount Step 0 i = i + 1 rs1.Edit rs1!MNO = i rs1.Update rs1.MoveNext Next i rs2.MoveLast: rs2.MoveFirst ii = 10000 For ii = 1 To rs2.RecordCount Step 0 ii = ii + 1 rs2.Edit rs2!MNO = ii rs2.Update rs2.MoveNext Next ii Set rs1 = Nothing Set rs2 = Nothing

جزاكم الله خيرا. لكن هل هناك طريقة لحذف هذه المسافة الموجودة في أول الصف من خلال برنامج الورد؟

حذف المسافة الزائدة من أول الصف يتم من خلال قائمة (إزالة) والنقر على بند (إزالة المسافات البيضاء الزائدة بداية الفقرات). بخصوص ترتيب الشعر: ذكرت لك أخي العزيز أن الخاصية موجودة عندما يتم فهرسة القصائد والأبيات الشعرية من خلال إضافة البيان البحثية، وأما إضافة خاصية جديدة من أجل تطبيقها على جدول تم إنشاؤه بشكل آلي أو يدوي بغير إضافة البيان، فالأمر لن ينجح 100%؛ لأنه ليس في كل الأحيان تكون (ا و ي) ليست حرف روي، أيضاً أحياناً يتم تجاهل حرف الروي (حرف الخروج) وحرف الوصل الذي بعده، وهذا لا يدركه برنامج آلي؛ لذا الأمر متعذر آلياً ولن تكون النتائج صحيحة 100%، وهذا الأمر شرحته في الفيديو السابق الذي وضعت لك رابطه.

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

تمام أخي الفاضل، بخصوص حذف المسافة الزائدة في أول الصف من الجدول. فعلا يتم تنفيذ هذا من خلال الإضافة، فجزاكم الله خيرا. المشكلة كانت عندي أنني لا أعرف الأمر من خلال الورد لحذف هذه المسافة الزائدة في أول الصف، فلو بحثت بعلامة فقرة بعدها مسافة في الجدول، لا يتم تنفيذ هذه العملية. أما بخصوص ترتيب الشعر، فأحيانا يأتي ملف فيه جدول يحتوي على مئات من الأبيات الشعرية على هذه الهيئة: نَحْنُ جَزَيْناكُمْ بِيَوْمِ بَدْرِ والحَرْبُ بَعْدَ الحَرْبِ ذاتُ سُعْرِ هند بنت عتبة 6/11 والمطلوب ترتيب هذه الأبيات على حسب القافية. وكان الاقتراح: أن نضيف خاصية ترتيب جدول فيه شعر على القافية. وقد عملت هذا الماكرو السابق، وأجريته على أكثر من خمسة آلاف بيت، فكانت النتيجة تقارب 95%. فأحببت أن تلحق هذه الخاصية (ترتيب شعر في جدول) للإضافة، وستكون -إن شاء الله- من أجمل ما يلحق بهذه الإضافة. * ملحوظة: ليتك تخبرني بأمر حذف المسافة الزائدة من أول الصف.

هذا كل اللي تحتاج اليه : dim strQuery as string strQuery="Sale_Daily" DoCmd.OpenQuery strQuery جعفر

جرب هذا الكود Sub Filter_me() Dim Ar_sh(), Itm Dim M As Worksheet Dim Ro%, t%, i%, k%, Y% Dim Cret As Range Dim Filter_rg As Range Set M = Sheets("Main") Set Cret = M.Range("A2:L3") With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With k = -1 For i = 1 To Sheets.Count If Sheets(i).Name <> M.Name Then k = k + 1 ReDim Preserve Ar_sh(k) Ar_sh(k) = Sheets(i).Name End If Next t = 8: Y = 8 M.Range("A8:N5000").ClearContents For Each Itm In Ar_sh With Sheets(Itm) If .FilterMode Then .ShowAllData Ro = .Cells(Rows.Count, 1).End(3).Row Set Filter_rg = .Cells(3, 1).Resize(Ro - 3, 12) Filter_rg.AdvancedFilter 1, Cret .Range("A4").Resize(Ro - 3, 12).SpecialCells(12).Copy M.Cells(t, 1).PasteSpecial (12) t = M.Cells(Rows.Count, 1).End(3).Row + 1 M.Cells(Y, "N").Resize(t - Y) = .Name Y = t If .FilterMode Then .ShowAllData End With Next Itm With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .CutCopyMode = False End With End Sub الملف مرفق Hadi.xlsm

إليكم أيها الزملاء برنامج كنترول Control2021pro لكنترول هذا العام البرنامج للمرحلتين الابتدائية و الاعدادية: البرنامج سهل وبسيط ويشمل على : للترمين- لكشوف للنتيجة بعد انهاء الرصد للترمين - شهادات للترمين - كشوف الجان بالاضافة إلى سرعة عالية جدا فى اداء العمليات الحسابية والمعالجات المختلفة و يمكن التحكم فى كل وظائف البرنامج بواسطة لوحة التحكم ارجو منكم تجربته وأنتظر تعليقاتكم ... تـــم رفع أخر تعديلات للبرنامج هنا 161502775899311.rar

السلام عليكم أهلا ومرحبا بك أخي الكريم بين إخوانك وزملاؤك مرفق مضغوط لمجلد (فولدر) وبه ملفان الملف الأول DATA وبه بعض البيانات الافتراضي وبه ايضا كود الملف الثاني Sample لاتغيره ولاتحركه من هذا المجلد أولا فك الضغط وخزن المجلد كاملا في المكان الذي تريد ثانيا إفتح الملف الأول DATA ثم إضغط علي الزر الأحمر لتشغيل الكود سيقوم بفتح الملف Sample بعدد مرات العملاء وفي كل مرة ينقل إليه البيانات ويخزنه في نفس المجلد برقم الوحدة والقطاع كما تريد ثم يغلق الملف تفضل المرفق a_tolba.rar

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