اظهار الترقيم مع السنة الحالية

للرفع والتذكير

السلام عليكم اين المشاركة الموضوع صعب

تفضل أخي

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

On Error Resume Next
Dim td As String
td = Year(Date)
DoCmd.GoToRecord , , acNewRec
Me!ReCode = Nz(DCount("[ReCode]", "[tCandidate]"), 0) + 1 & "/" & td

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

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, Nominator, [Language], DateofBirth, [GEC No], [DDCCode], [PDO Permit], [HSE Passprt No],[recode])"

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.Nominator, tCandidateTemp.Language, tCandidateTemp.[Date of Birth], tCandidateTemp.[GEC No], tCandidateTemp.[DDCCode], tCandidateTemp.[PDO Permit], tCandidateTemp.[HSE Passprt No], tCandidateTemp.[recode]"

strSQL = strSQL & "FROM tCandidateTemp;"

DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

DoCmd.DeleteObject acTable, "tCandidateTemp"

MsgBox "Been Imported And Save the Data Successfully"

End Sub

للرقع والتذكير