Alternetif koları ekledim.İstenilen kadar harf girilebilir.select casede belki hata olabilir format iiçin.
Kod:
Private Sub Tsipno_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Dim Hrf As String
Dim hafizayaAl, i As Integer
Dim kacKarakter, rakam
Const accessKarakterSayisi = 12
Dim fark, formatAl
hafizayaAl = Tsipno.Value
kacKarakter = Len(hafizayaAl)
fark = accessKarakterSayisi - kacKarakter
Hrf = hafizayaAl
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
baglan.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\veritabani.mdb"
SqlMax = "SELECT Siparis_No FROM SiparisKayitlari WHERE left(Siparis_No," & Len(hafizayaAl) & ") = '" & _
hafizayaAl & "' and IsNumeric(right(Siparis_No, " & fark & "))group by Siparis_No order by Siparis_No desc"
rs.Open SqlMax, baglan, 1, 1
Select Case fark
Case 11: formatAl = "00000000000"
Case 10: formatAl = "0000000000"
Case 9: formatAl = "000000000"
Case 8: formatAl = "00000000"
Case 7: formatAl = "0000000"
Case 6: formatAl = "000000"
Case 5: formatAl = "00000"
Case 4: formatAl = "0000"
Case 3: formatAl = "000"
Case 2: formatAl = "00"
Case 1: formatAl = "0"
End Select
If rs.RecordCount > 0 Then
For i = 1 To Len(rs(0))
If Mid(rs(0), i, 1) > 0 And IsNumeric(Mid(rs(0), i, 1)) Then
rakam = rakam & Mid(rs(0), i, 1)
End If
Next
gecici = IIf(IsNull(rs(0)), 1, rakam + 1)
Tsipno = Hrf & Format(gecici, formatAl)
Else
gecici = IIf(IsNull(rs(0)), 1, rakam + 1)
Tsipno = Hrf & Format(gecici, formatAl)
End If
Hrf = vbNullString
rs.Close
baglan.Close
Set rs = Nothing
Set baglan = Nothing
End Sub
