07-05-20, 09:30 PM
كود استعمله دائما مع مختلف الجداول فقط استدعيه بواسطة اسم الجدول والمفتاح
مثال
textbox1.text=GetAutoIncrement(customers, id)
Public Function GetAutoIncrement(TableName, CoulmnName) As String
Dim Dtmb As New DataTable
Dim Klm As String = DateTime.Now.Year
con.Close()
Connect()
con.Open()
Dim vid As String = Nothing
Dim cb1 As String = "SELECT top 1 " & CoulmnName & " FROM " & TableName & " order by " & CoulmnName & " desc"
cmd = New SqlCommand(cb1)
cmd.Connection = con
Dim da As New System.Data.SqlClient.SqlDataAdapter
da.SelectCommand = cmd
da.Fill(Dtmb)
con.Close()
'التحقق من الشرط اسفله
If Dtmb.Rows.Count > 0 Then '
If Mid(Dtmb.Rows(0)(0).ToString(), 3, 2) > Mid(Year(Now), 3, 2) Then
MsgBox("لا يمكنك الاضافة ")
End If
End If
If Dtmb.Rows.Count = 0 Then
If Date.Now.Month = 1 And Date.Now.Day = 1 Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
Else
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
End If
Else
Select Case (Mid(Year(Now), 3, 2)) ' سنة
Case > Mid(Dtmb.Rows(0)(0).ToString(), 1, 2) ' new year
If Date.Now.Month = 1 And Date.Now.Day = 1 Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
Else
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
End If
Case = Mid(Dtmb.Rows(0)(0).ToString(), 1, 2) 'تفس السنة
' بداية السنة الجديدة مع ترقيم مستخدم
If Date.Now.Month = 1 And Date.Now.Day = 1 And Mid(DateTime.Now.Year, 3, 2) & "/" & "0001" = Dtmb.Rows(0)(0).ToString() Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
If Date.Now.Month = 1 And Date.Now.Day = 1 And Mid(DateTime.Now.Year, 3, 2) & "/" & "0001" <> Dtmb.Rows(0)(0).ToString() Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
End If
Else 'ليس بداية السنة والترقيم غير مستخدم
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
End If
End Select
con.Close()
End If
Return Id_AutoIncrement
End Function
مثال
textbox1.text=GetAutoIncrement(customers, id)
Public Function GetAutoIncrement(TableName, CoulmnName) As String
Dim Dtmb As New DataTable
Dim Klm As String = DateTime.Now.Year
con.Close()
Connect()
con.Open()
Dim vid As String = Nothing
Dim cb1 As String = "SELECT top 1 " & CoulmnName & " FROM " & TableName & " order by " & CoulmnName & " desc"
cmd = New SqlCommand(cb1)
cmd.Connection = con
Dim da As New System.Data.SqlClient.SqlDataAdapter
da.SelectCommand = cmd
da.Fill(Dtmb)
con.Close()
'التحقق من الشرط اسفله
If Dtmb.Rows.Count > 0 Then '
If Mid(Dtmb.Rows(0)(0).ToString(), 3, 2) > Mid(Year(Now), 3, 2) Then
MsgBox("لا يمكنك الاضافة ")
End If
End If
If Dtmb.Rows.Count = 0 Then
If Date.Now.Month = 1 And Date.Now.Day = 1 Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
Else
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
End If
Else
Select Case (Mid(Year(Now), 3, 2)) ' سنة
Case > Mid(Dtmb.Rows(0)(0).ToString(), 1, 2) ' new year
If Date.Now.Month = 1 And Date.Now.Day = 1 Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
Else
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
End If
Case = Mid(Dtmb.Rows(0)(0).ToString(), 1, 2) 'تفس السنة
' بداية السنة الجديدة مع ترقيم مستخدم
If Date.Now.Month = 1 And Date.Now.Day = 1 And Mid(DateTime.Now.Year, 3, 2) & "/" & "0001" = Dtmb.Rows(0)(0).ToString() Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
If Date.Now.Month = 1 And Date.Now.Day = 1 And Mid(DateTime.Now.Year, 3, 2) & "/" & "0001" <> Dtmb.Rows(0)(0).ToString() Then
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & "0001"
End If
Else 'ليس بداية السنة والترقيم غير مستخدم
Id_AutoIncrement = Mid(DateTime.Now.Year, 3, 2) & "/" & (Format(CDbl(Mid((Dtmb.Rows(0)(0)), 4, 4)) + 1, "0000"))
End If
End Select
con.Close()
End If
Return Id_AutoIncrement
End Function