منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

السلام عليكم.اخواني شكرا مسبقا لو سمحتو هذا الكود وجدته بالمنتدى للاستاذ حريف برمجة ربنا يبارك فيه
مشكلة صغيرة بس
الكود يعمل الترقيم هكذا 0001-2018
كيف أبدلو ليصبح يعمل هكذا 2018-0001
حاولت استبدالو لكن ما ضبطت و الله

كود :

   Sub shownewid()

        If Date.Now.Month = 1 And Date.Now.Day = 1 Then

            TextBox1.Text = Date.Now.Year & " - " & "0001"

            'TextBox1.Text = "0001" & " - " & Date.Now.Year

            Exit Sub

        End If

        Dim dp As New OleDbDataAdapter("select Top 1 ID from Table1 order by ID desc", conn)

        Dim dt As New DataTable

        dp.Fill(dt)

        If dt.Rows.Count = 0 Then

            'هنا لا يوجد سجلات نعمل التسلسل 0001

            TextBox1.Text = Date.Now.Year & " - " & "0001"

            'TextBox1.Text = "0001" & " - " & Date.Now.Year

        Else

            Dim idall As String = dt.Rows(0)(0).ToString

            idall = Replace(idall, " - ", "-")

            Dim strArr() As String = idall.Split("-")

            TextBox1.Text = Date.Now.Year & " - " & Val(strArr(1) + 1).ToString("0000")

            'TextBox1.Text = Val(strArr(1) + 1).ToString("0000") & " - " & Date.Now.Year

        End If

    End Sub

(17-04-18, 09:11 PM)حافظ حافظ كتب : [ -> ]السلام عليكم.اخواني شكرا مسبقا لو سمحتو هذا الكود وجدته بالمنتدى للاستاذ حريف برمجة ربنا يبارك فيه
مشكلة صغيرة بس
الكود يعمل الترقيم هكذا 0001-2018
كيف أبدلو ليصبح يعمل هكذا 2018-0001
حاولت استبدالو لكن ما ضبطت و الله

كود :

Sub shownewid() If Date.Now.Month = 1 And Date.Now.Day = 1 Then TextBox1.Text = Date.Now.Year & " - " & "0001" 'TextBox1.Text = "0001" & " - " & Date.Now.Year Exit Sub End If Dim dp As New OleDbDataAdapter("select Top 1 ID from Table1 order by ID desc", conn) Dim dt As New DataTable dp.Fill(dt) If dt.Rows.Count = 0 Then 'هنا لا يوجد سجلات نعمل التسلسل 0001 TextBox1.Text = Date.Now.Year & " - " & "0001" 'TextBox1.Text = "0001" & " - " & Date.Now.Year Else Dim idall As String = dt.Rows(0)(0).ToString idall = Replace(idall, " - ", "-") Dim strArr() As String = idall.Split("-") TextBox1.Text = Date.Now.Year & " - " & Val(strArr(1) + 1).ToString("0000") 'TextBox1.Text = Val(strArr(1) + 1).ToString("0000") & " - " & Date.Now.Year End If End Sub

وعليكم السلام ،،

تفضل الكود :

كود :

Sub shownewid()   'الصب المسئول عن إدراج تسلسل جديد

        'التأكد من بداية سنة جديدة لإعادة رقم التسلسل من 0001 ونوقف تنفيذ بقية الكود

        If Date.Now.Month = 1 And Date.Now.Day = 1 Then

            TextBox1.Text = "0001" & " - " & Date.Now.Year

            Exit Sub

        End If

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        Dim dp As New OleDbDataAdapter("select Top 1 ID from Table1 order by ID desc", conn)

        'نعمل داتا تيبل جديد لتحميله بالسجل

        Dim dt As New DataTable

        'امر تعبئة الداتا تيبل بجملة سيليكت

        dp.Fill(dt)

        If dt.Rows.Count = 0 Then

            'هنا لا يوجد سجلات نعمل التسلسل 0001

            TextBox1.Text = "0001" & " - " & Date.Now.Year

            '''''''''''''''''''''''''''''''''''''''''''''

        Else

            'هنا يوجد سجلات وتاريخ اليوم ليس بداية العام

            'متغير يحمل آخر سجل في الحقل

            Dim idall As String = dt.Rows(0)(0).ToString

            'نعمل استبدال الفراغ قبل وبعد الإشارة

            idall = Replace(idall, " - ", "-")

            'مصفوفة تحمل الشقين الموجودين الرقم والعام قبل وبعد الإشارة

            Dim strArr() As String = idall.Split("-")

            'نزيد 1 للرقم ليتم ادراج التسلسل الجديد

            TextBox1.Text = Val(strArr(0) + 1).ToString("0000") & " - " & Date.Now.Year

        End If

    End Sub

السلام عليكم .تسلم اخي الكريم حريف برمجة ربنا يديلك ما تتمناه.والله احترت كثير.ملفك شغال 100 بال 100 .انقل الاكواد كما هي و قاعدة البيانات كما هي لكن يجيني خطأ.و بملفك لا يوجد اي خطا.شو المكشل الله يكرمك

(17-04-18, 11:34 PM)حافظ حافظ كتب : [ -> ]السلام عليكم .تسلم اخي الكريم حريف برمجة ربنا يديلك ما تتمناه.والله احترت كثير.ملفك شغال 100 بال 100 .انقل الاكواد كما هي و قاعدة البيانات كما هي لكن يجيني خطأ.و بملفك لا يوجد اي خطا.شو المكشل الله يكرمك

وعليكم السلام ،،

المشكلة يوجد سجل فارغ في الجدول .

امسح السجل الفارغ وسوف يعمل مع المثال تمام ان شاء الله .

تأكد الجدول بعد فتحة يكون هكذا :

[attachment=17716]

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

آمين وياك يارب ،، بالتوفيق للجميع