مطلوب كود تكرار سجل مبني على نموذج رئيسي وفرعي لجدولين يربطهما رقم تلقائي في الرئيسي

[magdidir]

السلام عليكم ورحمة الله وبركاته

الاخوة الاعزاء في هذا المنتدى العظيم

لدي نموذج رئيسي HTableF مبني على جدول HTable  وفيه نموذج فرعي DIrsal يرتبطان بحقل رئيسي Id  ( ترقيم تلقائي ) مع حقل IDNO في النموذج الفرعي 

في النموذج الرئيسي HTableF  الحقل (INVNo) مبني على معادلة Me.Text60 = Nz(DMax("[INVNo]", "HTable") + 1, 3000)

بحاجة لكود تكرار السجل المكون من الرئيسي والفرعي مع مراعاة الترقيم التلقائي في النموذج الرئيسي بالاضافة للتسلسل برقم INVno 

ولكم مني فائق التقدير والاحترام

60000.rar

[Foksh]

1 ساعه مضت, magdidir said:

السلام عليكم ورحمة الله وبركاته

الاخوة الاعزاء في هذا المنتدى العظيم

لدي نموذج رئيسي HTableF مبني على جدول HTable  وفيه نموذج فرعي DIrsal يرتبطان بحقل رئيسي Id  ( ترقيم تلقائي ) مع حقل IDNO في النموذج الفرعي 

في النموذج الرئيسي HTableF  الحقل (INVNo) مبني على معادلة Me.Text60 = Nz(DMax("[INVNo]", "HTable") + 1, 3000)

بحاجة لكود تكرار السجل المكون من الرئيسي والفرعي مع مراعاة الترقيم التلقائي في النموذج الرئيسي بالاضافة للتسلسل برقم INVno 

ولكم مني فائق التقدير والاحترام

60000.rar 65.45 kB · 5 downloads

تفضل ، هذه فكرتي المتواضعة

60000.accdb

[magdidir]

14 دقائق مضت, Foksh said:

تفضل ، هذه فكرتي المتواضعة

60000.accdb 832 kB · 0 downloads

اخي العزيز @Foksh 

بارك االله فيك ،،،،

الكود يكرر سجل واحد من النموذج الفرعي ، وما اريده هو تكرار بيانات النموذج الرئيسي مع بيانات النموذج الفرعي

ولتوضيح الفكرة بشكل عام: قيد الرواتب الشهري يتكون من 32 موظف كل موظف بعدد الايام مضروب بسعر اليوم ، لذا احتاج لكود يكرر الراتب للشهر السابق وتغيير عدد الايام فقط

تسلم ايدك عالمحاولة 

[Foksh]

1 ساعه مضت, magdidir said:

الكود يكرر سجل واحد من النموذج الفرعي ، وما اريده هو تكرار بيانات النموذج الرئيسي مع بيانات النموذج الفرعي

 

اذا ، جرب الكود التالي :-

Private Sub Command137_Click()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim newID As Long
    Dim oldID As Long
    Dim newINVNo As Long
    
    If IsNull(Me.id) Then Exit Sub
    Set db = CurrentDb
    oldID = Me.id
    
    newINVNo = Nz(DMax("[INVNo]", "HTable"), 3000) + 1
    db.Execute "INSERT INTO HTable " & _
               "([INVNo], [Fdate], [compcode], [comName], [TaxId], [Note]) " & _
               "SELECT " & newINVNo & ", Fdate, compcode, comName, TaxId, Note " & _
               "FROM HTable WHERE ID = " & oldID
    
    newID = DMax("ID", "HTable")
    
    db.Execute "INSERT INTO Irsal " & _
              "(IDNO, SenfNO, senfname, NetWight, price, Total) " & _
              "SELECT " & newID & ", SenfNO, senfname, NetWight, price, Total " & _
              "FROM Irsal " & _
              "WHERE IDNO = " & oldID
    
    Me.Requery
    Me.RecordsetClone.FindFirst "ID = " & newID
    Me.Bookmark = Me.RecordsetClone.Bookmark
    
ExitHere:
    Set db = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description & vbNewLine & _
           "رقم الخطأ: " & Err.Number, vbCritical
    Resume ExitHere
End Sub

 

60000.accdb

[magdidir]

26 دقائق مضت, Foksh said:

On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim newID As Long
    Dim oldID As Long
    Dim newINVNo As Long
    
    If IsNull(Me.id) Then Exit Sub
    Set db = CurrentDb
    oldID = Me.id
    
    newINVNo = Nz(DMax("[INVNo]", "HTable"), 3000) + 1
    db.Execute "INSERT INTO HTable " & _
               "([INVNo], [Fdate], [compcode], [comName], [TaxId], [Note]) " & _
               "SELECT " & newINVNo & ", Fdate, compcode, comName, TaxId, Note " & _
               "FROM HTable WHERE ID = " & oldID
    
    newID = DMax("ID", "HTable")
    
    db.Execute "INSERT INTO Irsal " & _
              "(IDNO, SenfNO, senfname, NetWight, price, Total) " & _
              "SELECT " & newID & ", SenfNO, senfname, NetWight, price, Total " & _
              "FROM Irsal " & _
              "WHERE IDNO = " & oldID
    
    Me.Requery
    Me.RecordsetClone.FindFirst "ID = " & newID
    Me.Bookmark = Me.RecordsetClone.Bookmark
    
ExitHere:
    Set db = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description & vbNewLine & _
           "رقم الخطأ: " & Err.Number, vbCritical
    Resume ExitHere

تسلم ايديك يا عبقري @Foksh ، وجعله في ميزان حسناتك ، كود اكثر من رائع 

بس طمعا في عبقريتك لو ما بدي اتعبك معاي ، تضيف لي عالكود جزء يغلق النموذج ويفتح السجل الجديد المكرر ، ولك مني جزيل الشكر

[magdidir]

28 دقائق مضت, magdidir said:

تسلم ايديك يا عبقري @Foksh ، وجعله في ميزان حسناتك ، كود اكثر من رائع 

بس طمعا في عبقريتك لو ما بدي اتعبك معاي ، تضيف لي عالكود جزء يغلق النموذج ويفتح السجل الجديد المكرر ، ولك مني جزيل الشكر

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

Private Sub Command137_Click()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim newID As Long
    Dim oldID As Long
    Dim newINVNo As Long
    
    If IsNull(Me.id) Then Exit Sub
    Set db = CurrentDb
    oldID = Me.id
    
    newINVNo = Nz(DMax("[INVNo]", "HTable"), 3000) + 1
    db.Execute "INSERT INTO HTable " & _
               "([INVNo], [Fdate], [compcode], [companyName], [TaxId], [Note]) " & _
               "SELECT " & newINVNo & ", Fdate, compcode, companyName, TaxId, Note " & _
               "FROM HTable WHERE ID = " & oldID
    
    newID = DMax("ID", "HTable")
    
    db.Execute "INSERT INTO Irsal " & _
              "(IDNO, SenfNO, senfname, NetWight, price, Total) " & _
              "SELECT " & newID & ", SenfNO, senfname, NetWight, price, Total " & _
              "FROM Irsal " & _
              "WHERE IDNO = " & oldID
    
    Me.Requery
    Me.RecordsetClone.FindFirst "ID = " & newID
    Me.Bookmark = Me.RecordsetClone.Bookmark
    DoCmd.Close acForm, Me.Name, acSaveYes
    DoCmd.OpenForm "HTableF"
    DoCmd.GoToRecord , , acLast
ExitHere:
    Set db = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description & vbNewLine & _
           "??? ?????: " & Err.Number, vbCritical
    Resume ExitHere
End Sub

[Foksh]

2 ساعات مضت, Foksh said:

    Me.Requery
    Me.RecordsetClone.FindFirst "ID = " & newID
    Me.Bookmark = Me.RecordsetClone.Bookmark

لا شكر على واجب اخي الكريم 

في هذا الجزء يتم فعلاً الذهاب للسجل الذي تم إضافته 🤔 .