اضافة ترقيم

خالد يحي الامام كتب:

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

القاعدة مرفقة وبها تعديل الاستاذة الفاضلة زهرةza-Data-ddc-UP.rar

بعد التحية اين اساتذتي الافاضل الموضوع طال الانتظار فيه

يمكنك اضافة نفس الكود المستخدم فى النموذج فى كود اضافة السجلات من الاكسل

و لكن لا يمكن اضافة الكود فى الجدول

او يمكنك استخدام حقل ترقيم تلقائى بدلا من الترقيم باستخدام الكود

لاحظ حقل id فى جدول tcandidate (تم اضافة هذا الحقل للتوضيح)

و لكن مشكلة هذه الطريقة هى نفسها مشكلة الترقيم التلقائى

اى انهك اذا حذفت سجل لن يستخدم رقمه مرة اخرى و بالتالى ستظهرارقام مفقودة

za-Data-ddc-UP.rar

mrnooo2000 كتب:

يمكنك اضافة نفس الكود المستخدم فى النموذج فى كود اضافة السجلات من الاكسل

و لكن لا يمكن اضافة الكود فى الجدول

او يمكنك استخدام حقل ترقيم تلقائى بدلا من الترقيم باستخدام الكود

لاحظ حقل id فى جدول tcandidate (تم اضافة هذا الحقل للتوضيح)

و لكن مشكلة هذه الطريقة هى نفسها مشكلة الترقيم التلقائى

اى انهك اذا حذفت سجل لن يستخدم رقمه مرة اخرى و بالتالى ستظهرارقام مفقودة

شكرا اخي على الاستجابة بالنسبة للطريقة الأولي افضل ولكن اضفت نفس الكود المستخدم في النموذج وكما هو منسوخ الكود ولكن لم يتم

Private Sub CmdImport_Click()

Dim strPath As String

Dim strSQL As String

strPath = Application.CurrentProject.Path & "\fileReg.xls"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tCandidateTemp", strPath, True

DoCmd.SetWarnings False

strSQL = "INSERT INTO tCandidate ( [Job Number], [ROP Licence Number], ROPLicenceCategory, ROPLicenceExpiryDate, FirstName, SecondName, FamilyName, GSM, [Language], DateofBirth, [GEC No], [DDCCode], [PDO Permit], [Expiry Date PDO], [HSE Passprt No] )"

strSQL = strSQL & "SELECT tCandidateTemp.[Job Number], tCandidateTemp.[ROP Licence Number], tCandidateTemp.[ROP Licence Categories], tCandidateTemp.[ROP Licence Expiry Date], tCandidateTemp.FirstName, tCandidateTemp.[second Name], tCandidateTemp.FamilyName, tCandidateTemp.GSM, tCandidateTemp.Language, tCandidateTemp.[Date of Birth], tCandidateTemp.[GEC No], tCandidateTemp.[DDCCode], tCandidateTemp.[PDO Permit], tCandidateTemp.[Expiry Date PDO], tCandidateTemp.[HSE Passprt No]"

strSQL = strSQL & "FROM tCandidateTemp;"

DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

DoCmd.DeleteObject acTable, "tCandidateTemp"

Me!ReCode = Nz(DMax("[ReCode]", "[tCandidate]"), 0) + 1 هذا هو الكود المضاف

MsgBox "Been Imported And Save the Data Successfully"

End Sub

لا يا أخى الامر ليس بهذه البساطة

اليك الكود بعد التعديل

Private Sub CmdImport_Click()
Dim strPath As String
Dim strSQL As String
strPath = Application.CurrentProject.Path & "\fileReg.xls"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tCandidateTemp", strPath, True
 DoCmd.SetWarnings False

 '*******************************************************************************************************
 CurrentDb.Execute ("ALTER TABLE tCandidateTemp ADD COLUMN ReCode Text;")
 MyAutonumber
 '********************************************************************************************************

strSQL = "INSERT INTO tCandidate ( [Job Number], [ROP Licence Number], ROPLicenceCategory, ROPLicenceExpiryDate, FirstName, SecondName, FamilyName, GSM, [Language], DateofBirth, [GEC No], [DDCCode], [PDO Permit], [Expiry Date PDO], [HSE Passprt No] )"
strSQL = strSQL & "SELECT tCandidateTemp.[Job Number], tCandidateTemp.[ROP Licence Number], tCandidateTemp.[ROP Licence Categories], tCandidateTemp.[ROP Licence Expiry Date], tCandidateTemp.FirstName, tCandidateTemp.[Second Name], tCandidateTemp.FamilyName, tCandidateTemp.GSM, tCandidateTemp.Language, tCandidateTemp.[Date of Birth], tCandidateTemp.[GEC No], tCandidateTemp.[DDCCode], tCandidateTemp.[PDO Permit], tCandidateTemp.[Expiry Date PDO], tCandidateTemp.[HSE Passprt No]"
strSQL = strSQL & "FROM tCandidateTemp;"
DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

DoCmd.DeleteObject acTable, "tCandidateTemp"
MsgBox "Been Imported And Save the Data Successfully"
End Sub
Private Sub MyAutonumber()
 Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim xx, mymask As String
 Dim td As DAO.TableDef
Dim fld As DAO.Field
mymask = "0000" & Chr(34) & "/2010" & Chr(34)

      Set db = CurrentDb
    Set td = db.TableDefs("tCandidateTemp")
    Set fld = td.Fields("recode")
    fld.Properties.Append fld.CreateProperty("InputMask", dbText, mymask)

'Me!ReCode = Nz(DMax("[ReCode]", "[tCandidate]"), 0) + 1
xx = Nz(DMax("[ReCode]", "[tCandidate]"), 0)
Set rs = CurrentDb.OpenRecordset("tCandidateTemp")
'Set rs = Me.Recordset
rs.MoveFirst
MsgBox rs.RecordCount
For i = 1 To rs.RecordCount
rs.Edit
rs!ReCode = xx + i
rs.Update
rs.MoveNext
Next
rs.Close

End Sub

Run error.rar

mrnooo2000 كتب:

لا يا أخى الامر ليس بهذه البساطة

اليك الكود بعد التعديل

Private Sub CmdImport_Click()
Dim strPath As String
Dim strSQL As String
strPath = Application.CurrentProject.Path & "\fileReg.xls"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tCandidateTemp", strPath, True
 DoCmd.SetWarnings False

 '*******************************************************************************************************
 CurrentDb.Execute ("ALTER TABLE tCandidateTemp ADD COLUMN ReCode Text;")
 MyAutonumber
 '********************************************************************************************************

strSQL = "INSERT INTO tCandidate ( [Job Number], [ROP Licence Number], ROPLicenceCategory, ROPLicenceExpiryDate, FirstName, SecondName, FamilyName, GSM, [Language], DateofBirth, [GEC No], [DDCCode], [PDO Permit], [Expiry Date PDO], [HSE Passprt No] )"
strSQL = strSQL & "SELECT tCandidateTemp.[Job Number], tCandidateTemp.[ROP Licence Number], tCandidateTemp.[ROP Licence Categories], tCandidateTemp.[ROP Licence Expiry Date], tCandidateTemp.FirstName, tCandidateTemp.[Second Name], tCandidateTemp.FamilyName, tCandidateTemp.GSM, tCandidateTemp.Language, tCandidateTemp.[Date of Birth], tCandidateTemp.[GEC No], tCandidateTemp.[DDCCode], tCandidateTemp.[PDO Permit], tCandidateTemp.[Expiry Date PDO], tCandidateTemp.[HSE Passprt No]"
strSQL = strSQL & "FROM tCandidateTemp;"
DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

DoCmd.DeleteObject acTable, "tCandidateTemp"
MsgBox "Been Imported And Save the Data Successfully"
End Sub
Private Sub MyAutonumber()
 Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim xx, mymask As String
 Dim td As DAO.TableDef
Dim fld As DAO.Field
mymask = "0000" & Chr(34) & "/2010" & Chr(34)

      Set db = CurrentDb
    Set td = db.TableDefs("tCandidateTemp")
    Set fld = td.Fields("recode")
    fld.Properties.Append fld.CreateProperty("InputMask", dbText, mymask)

'Me!ReCode = Nz(DMax("[ReCode]", "[tCandidate]"), 0) + 1
xx = Nz(DMax("[ReCode]", "[tCandidate]"), 0)
Set rs = CurrentDb.OpenRecordset("tCandidateTemp")
'Set rs = Me.Recordset
rs.MoveFirst
MsgBox rs.RecordCount
For i = 1 To rs.RecordCount
rs.Edit
rs!ReCode = xx + i
rs.Update
rs.MoveNext
Next
rs.Close

End Sub

لك الف شكر اخي ولكن عند التطبيق ظهرت لي هذا الخطا كما في الصورة المرفقة في الملف

بسيطة أخى

قم بالغاء السطر الاول من الكود

و هو خاص باضافة الحقل الى الجدول

 CurrentDb.Execute ("ALTER TABLE tCandidateTemp ADD COLUMN ReCode Text;")

mrnooo2000 كتب:

بسيطة أخى

قم بالغاء السطر الاول من الكود

و هو خاص باضافة الحقل الى الجدول

 CurrentDb.Execute ("ALTER TABLE tCandidateTemp ADD COLUMN ReCode Text;")

اكرر الشكر اخي mrnooo2000 ولكن نفس المشكلة قائمة كما في السطر Set fld = td.Fields("Recode")

والمهممرفق اليك القاعدة والزر موجود في نموذج Main Form وهو لتصدير البيانات من ملف اكسل وكذلك الملف مرفق واكرر اعتزاري لكثرة الاسئلة واكنه موضوع شاغلني كثيرا Data-ddc-Num.rar

السلام عليكم اين الاخوة الاعضاء في انتظار مساعدتكم المعهود بها دوما وربنا يوفقكم إلى ما فيه الخير

أخى العزيز

تفضل ما تريد

نفس الكود الاول

و لكن كان هناك جزء بسيط

و هو اضافة حقل recode الى استعلام الاضافة

Data-ddc-Num.rar

لك الف شكر اخي الحمد لله تم ما هو مطاوب