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

يعد اذن اخي على هذا الكود ربما يكون اسرع قليلاٌ لانه يعنمد على المصفوفات Sub move_data() Sheets("تصفية").Cells.ClearContents Dim arr() Dim i%, m%: m = 1 For i = 1 To 50 If i = 11 Then i = 44 ReDim Preserve arr(1 To m) arr(m) = i m = m + 1 Next m = 1 For i = LBound(arr) To UBound(arr) Sheets("تصفية").Cells(2, m).Resize(100, 1).Value = _ Sheets("البيانات").Cells(2, arr(i)).Resize(100, 1).Value m = m + 1 Next Erase arr End Sub

عمل أنيق و سؤال أنيق أعجبني السؤال و الإجابة شكراً لكم أخواني @ابو زاهر @Shivan Rekany @صالح حمادي

اتفضل تم استخدام الكود هكذا Private Sub أمر6_Click() Dim rst As DAO.Recordset Dim ddate As Date Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [HRR]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!Atarih < ddate Then MsgBox (rst!Rjmfatwra & " هناك تسلسل خاطئ في التاريخ للفاتورة رقم ") Else ddate = rst!Atarih End If rst.MoveNext Next i End Sub ومن قبل قام استاذ صالح بتعديل الكود واليك المرفق بعد تعديل فحص تسلسل التاريح (1).accdb

وعليكم السلام تفضلى نقل بيانات.xlsm

السلام عليكم Dim rst As DAO.Recordset Dim rst As DAO.Recordset Dim ddate As Date Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [HRR]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!Atarih < ddate Then MsgBox "هناك تسلسل خاطئ في التاريخ للفاتورة رقم: " & rst!Rjmfatwra Else ddate = rst!Atarih End If rst.MoveNext Next i غير مكان السطر: rst.MoveNext اجعلها تحت End If

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

اختصار الكود Option Explicit Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString Next End If N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) Application.ScreenUpdating = True 1 End Sub

السلام عليكم ورحمة الله وبركاتة برنامج بسيط لطباعة الباركود على ورق a4 لتحميل البرنامج رابط الفيديو

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

الحمد لله. ربي يوفقك شكرا صديقي Shivan Rekany

اعتقد اننا رايت في مشاركه له انه مريض دعواتكم اليه@اباجودي اللهم إنا نسألك بأسمائك الحسنى وبصفاتك العلا وبرحمتك التي وسعت كلّ شيء أن تمنّ علينا بالشفاء العاجل، وألّا تدع فينا جرحاً إلّا داويته ولا ألماً إلا سكنته ولا مرضاً إلا شفيته، وألبسنا ثوب الصحة والعافية عاجلاً غير آجلاً وشافِنا وعافِنا واعف عنا، واشملنا بعطفك ومغفرتك وتولّنا برحمتك يا أرحم الراحمين اللهم ربي كما انزلت شفاك لابني زاهر رغم المرض القاتل الذي الم به فاشفيته ان تنزل الشفاء لكل مريض رحماك يالله تحياتي اليكم

استاذي صالح الله يعطيك العافيه هو المطلوب بكله والسموحه يالغالي لم انتبه لهذه المشاركه الف الف شكر رينا بعطيك العافيه تماما الان شكر اليك استاذي ابو محمد نعم هو المطلوب ولكنني لم انتبه لمشاركت الاستاذ صالح ربنا يعطيكم العافيه استاتذي الكرام شكر شكر كثير حلو جدا تحياتي اليكم استاتذتي الكرام

الكود فقظ انا وضعته و لم أجربه لكن في رأي ان Next يجب ان توضع بعد End If وليس قبل End sub حتى لا تتكرر عبارة  N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181),  عند كل حلقة تكرارية ليبدو الكود بهذا الشكل Option Explicit Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString End If Next N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) 1: Application.ScreenUpdating = True End Sub

حفظكم الله و رعاكم

الاستاذ القدير jjafferr نتمنى من الله العلي القدير ان يمن عليك وعلى عائلتك الكريمة بالصحة والعافية يارب يارب

بعد إذن الأستاذ سليم اكتب Next في سطر قبل End sub ليصبح الكود Sub Click3() Application.ScreenUpdating = False On Error GoTo 1 Dim ws As Worksheet: Set ws = Sheets("add") Dim N, C2 As Range Dim I% ' On Error Resume Next For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row) If N.Value = "محمود" Or N.Value = "احمد" Then For I = 111 To 256 If I = 117 Or I = 164 Or I = 183 Then I = I + 1 If I = 180 Then I = I + 2 N.Offset(0, I) = vbNullString Next End If N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2)) Application.ScreenUpdating = True Next 1 End Sub

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

لم تخبرني هل هذا هو المطلوب أم لا ؟

وعليكم السلام فهم السؤال هو نصف الاجابة .. ولم استوعب المطلوب بالتمام ولكن وحسب ما فهمت قمت بالتعديل على المثال اتمنى ان اكون قريبا من طلبك db1.mdb

لاحظ اخى الكريم المعادلة الأخرى الجديدة -1asd.xlsm

اتفضل تم استخدام هذا الكود Private Sub أمر6_Click() Dim Aded As Long Dim FirDate As Date Dim Curdate As Date Dim Curdate1 As Date Dim Teakid As Byte Aded = Me.YWMA_sub.Form.Recordset.RecordCount Me.YWMA_sub.SetFocus Me.YWMA_sub.Form.Atarih.SetFocus DoCmd.GoToRecord , , acFirst FirDate = Me.YWMA_sub.Form.Atarih For i = 0 To Aded - 1 Curdate1 = Me.YWMA_sub.Form.Atarih If Curdate1 > FirDate Then Curdate = Me.YWMA_sub.Form.Atarih Teakid = 1 End If If Curdate1 > FirDate Then DoCmd.GoToRecord , , acNext ElseIf Curdate1 = FirDate And Teakid = 0 Then DoCmd.GoToRecord , , acNext Else MsgBox " ( " & Me.YWMA_sub.Form.Rjmfatwra & " ) " & "هناك تسلسل التاريخ خطأ في رقم الفاتورة", vbMsgBoxRtlReading, "تنبيه" Exit Sub End If Next i End Sub فحص تسلسل التاريح.accdb

السلام عليكم جربت اكثر من برنامج اصلاح وكانت النتيجة جدول واحد سليم وخالي من البيانات تفضلوا برنامج الاصلاح accessfix.rar