مشكلة في كود الترحيل

[amir_adam83]

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

لدي جدولين الاول يتم استدعاء الموظفين فيه ومن ثم تجهيز المستحقات والاستقطاعات لهم

والجدول الثاني يتم ترحيل اليه البيانات لعملية الصرف 

وهذه العمليه تتم عن طريق نموذج وسيط

كما هوا بالمرفق تم عمل الكود ولكن لم اعلم اين المشكله

شكرا لكم

الترحيل.rar

[ابو ياسين المشولي]

في الكود اوقف هذا الكود

On Error Resume Next

وبيطلع لك ان كود الترحيل فيه خطاء

[amir_adam83]

ابو ياسين المشولي

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

ولكن هذا ما ظهر لي بعد ان حجبت

On Error Resume Next

 

[ابو ياسين المشولي]

منذ ساعه, amir_adam83 said:

ابو ياسين المشولي

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

ولكن هذا ما ظهر لي بعد ان حجبت

On Error Resume Next

 

نعم اخي انه خطا اعمل استعلام الحاق ثم حوله الى كود

[biskra]

أظن أن هناك خطأ في الكود فيما يخض القيمة التي يأخذها من النموذج، جرب إعادة صياغة الكود على أساس الفكرة التالية:

INSERT INTO Table_777_MaturityscheduleOte (x, y, z) SELECT x, y, z FROM Table_776_Maturityschedule WHERE CodeStaff = " & Me.CodeStaff

حيث أن xyz تعوض بالحقول المطلوب إدخالها الى الجدول مع مراعاة أن تكون طبيعة الحقول من نفس النوع،

و يمكن أن تصمم العملية عن طريق الإستعلام و يمكنك بعدها تحويلها إلى كود بالطريقة التي ترغب فيها.

[amir_adam83]

On 2/14/2021 at 7:39 PM, ابو ياسين المشولي said:

نعم اخي انه خطا اعمل استعلام الحاق ثم حوله الى كود

كيف لي ان اعمل استعلام الحاق وكيف احوله الى كود

بارك الله فيك

[biskra]

تفضل من خلال الأداة التالية يمكنك التحويل في الإتجاهين

 

Sql2vba.zip

تم تعديل فبراير 15, 2021 بواسطه biskra

[د.كاف يار]

تفضل هذا التعديل اخي الكريم

Dim My_Selectdata1 As String
Dim My_Selectdata2 As String
Dim My_SelectdataWhere As String
My_Selectdata1 = "INSERT INTO Table_777_MaturityscheduleOte ( Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink )"
My_Selectdata2 = "SELECT Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink FROM Table_776_Maturityschedule"
My_SelectdataWhere = " WHERE (((Table_776_Maturityschedule.CodeStaff) Between [Forms]![Frm_776_Monthlyroutinescreen]![TextCodeEmp] And [Forms]![Frm_776_Monthlyroutinescreen]![ToextCodeEmp]));"

If Me.TextCodeEmp = "" Or Me.TextCodeEmp = " " Or Me.TextCodeEmp = Null Or Me.TextCodeEmp = 0 Then
MsgBox "يجب ادخال كود الموظف للاستمرار", vbCritical + vbMsgBoxRight, "تنبيه"
Exit Sub
Else

If MsgBox("هل تريد ترحيل الملف المحدد الى جدول الاستحقاق ؟" & _
    vbNewLine & " كود الموظف" & " من " & " : " & Me.TextCodeEmp & "  -  " & " الى " & " : " & Me.ToextCodeEmp, vbYesNo + vbMsgBoxRight + vbExclamation) = vbYes Then

    DoCmd.SetWarnings False
    DoCmd.RunSQL My_Selectdata1 & My_Selectdata2 & My_SelectdataWhere
    DoCmd.RunSQL "DELETE FROM Table_776_Maturityschedule" & My_SelectdataWhere

    DoCmd.SetWarnings True

    MsgBox "تم عمل الروتين الشهري وتم اغلاق الروتين", vbInformation + vbMsgBoxRight, "نقل بيانات الرواتب"
    DoCmd.Close

End If

End If

 

الترحيل.rar

[amir_adam83]

12 hours ago, د.كاف يار said:

تفضل هذا التعديل اخي الكريم

Dim My_Selectdata1 As String
Dim My_Selectdata2 As String
Dim My_SelectdataWhere As String
My_Selectdata1 = "INSERT INTO Table_777_MaturityscheduleOte ( Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink )"
My_Selectdata2 = "SELECT Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink FROM Table_776_Maturityschedule"
My_SelectdataWhere = " WHERE (((Table_776_Maturityschedule.CodeStaff) Between [Forms]![Frm_776_Monthlyroutinescreen]![TextCodeEmp] And [Forms]![Frm_776_Monthlyroutinescreen]![ToextCodeEmp]));"

If Me.TextCodeEmp = "" Or Me.TextCodeEmp = " " Or Me.TextCodeEmp = Null Or Me.TextCodeEmp = 0 Then
MsgBox "يجب ادخال كود الموظف للاستمرار", vbCritical + vbMsgBoxRight, "تنبيه"
Exit Sub
Else

If MsgBox("هل تريد ترحيل الملف المحدد الى جدول الاستحقاق ؟" & _
    vbNewLine & " كود الموظف" & " من " & " : " & Me.TextCodeEmp & "  -  " & " الى " & " : " & Me.ToextCodeEmp, vbYesNo + vbMsgBoxRight + vbExclamation) = vbYes Then

    DoCmd.SetWarnings False
    DoCmd.RunSQL My_Selectdata1 & My_Selectdata2 & My_SelectdataWhere
    DoCmd.RunSQL "DELETE FROM Table_776_Maturityschedule" & My_SelectdataWhere

    DoCmd.SetWarnings True

    MsgBox "تم عمل الروتين الشهري وتم اغلاق الروتين", vbInformation + vbMsgBoxRight, "نقل بيانات الرواتب"
    DoCmd.Close

End If

End If

 

الترحيل.rar 43.35 kB · 5 downloads

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

هذا هو المطلوب بلفعل

شكرا لك

 

 

د.كاف يار

شكرا لك