توليد ارقام وحروف عشوائية فريد لكل سجل عند تحديث التاريخ

**محمد التميمي** · ديسمبر 30, 2024

السلام عليكم:

طيب الله اوقاتكم بكل خير .....

في الملف المرفق لدي مربعين نص مخصصين الاول لتاريخ الاصدار والثاني لتاريخ النفاد (الانتهاء) وضعت كود بسيط بعد التحديث في تاريخ الاصدار ليصنع لي تاريخ نفاد بعد سنة بشكل تلقائي بمجرد ادخال تاريخ اصدار.

المطلوب اخواني الكرام::

عند البدء بادخال تاريخ اصدار جديد وانشاء تاريخ نفاد بعد سنة يقوم برنامج اكسس بتوليد ارقام وحروف انكليزي عشوائية عدد (8) في مربع النص (number) ويحفظ في الجدول بنفس الحقل ولا يتم تغييره الا بكتابة تواريخ جديدة......

علما اني بحثت في المنتدى ووجت امثلة ولكن لاتتطابق مع ما اوريد.

مع فائق الشكر والتقدير ...

New.accdb

تم تعديل ديسمبر 30, 2024 بواسطه محمد التميمي

**ابو جودي** · ديسمبر 30, 2024

طلبك موجود هنا وأكثر

**محمد التميمي** · ديسمبر 30, 2024

منذ ساعه, ابو جودي said:

طلبك موجود هنا وأكثر

السلام عليكم ابا جودي الغالي

اعتقد لم اوفق في التنسيق بعد جلب الكود الى وحدة نمطية لان ملف الباسويرد لا يشبه ملفي المرفق ... مع التقدير

تم تعديل ديسمبر 30, 2024 بواسطه محمد التميمي

**ابو جودي** · ديسمبر 30, 2024

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

بس ان شاء الله ابشر

**محمد التميمي** · ديسمبر 30, 2024

1 دقيقه مضت, ابو جودي said:

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

بس ان شاء الله ابشر

تسلم ياغالي ماقصرت

**ابو جودي** · ديسمبر 30, 2024

33 دقائق مضت, محمد التميمي said:

تسلم ياغالي ماقصرت

الله يسلمك

شوف نظريا كده دى الاجابة

اعمل وحدة نمطية جديدة فى قاعدة البيانات بتاعتك واعطها مثلا الاسم : basGeneratorPassword
وضع بها الاكواد الاتية ...

Public Const DefaultLength As Integer = 10
Public Const DefaultSpecialChars As String = "'?,./<>|\[]{}:;#$%&()*+-@_""" & "!`~@#$%^&*()=€¥»«©®™°¢£•÷×¶"


Public Function GeneratePassword( _
                                    Optional Length As Integer = DefaultLength, _
                                    Optional bNumeric As Boolean = True, _
                                    Optional bUpperAlpha As Boolean = True, _
                                    Optional bLowerAlpha As Boolean = True, _
                                    Optional bSpecialChr As Boolean = True, _
                                    Optional sSpecialChr As String = DefaultSpecialChars) As String


    On Error GoTo Error_Handler

    Dim AllowedChars() As Variant
    Dim iCounter As Integer
    Dim i As Integer
    Dim iRndChar As Integer
    Dim iNoAllowedChars As Long
    Dim sGeneratedPwd As String
    Const sModName = "modGeneratorPassword"

    ' Initialize array
    ReDim AllowedChars(0)

    ' Numeric
    If bNumeric Then
        For i = 48 To 57
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Uppercase Alphabet
    If bUpperAlpha Then
        For i = 65 To 90
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Lowercase Alphabet
    If bLowerAlpha Then
        For i = 97 To 122
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Special Characters
    If bSpecialChr And Trim(sSpecialChr) <> "" Then
        For i = 1 To Len(sSpecialChr)
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = Asc(Mid$(sSpecialChr, i, 1))
        Next i
    End If

    ' Generate Password
    Randomize
    iNoAllowedChars = UBound(AllowedChars)
    For i = 1 To DefaultLength
        iRndChar = Int((iNoAllowedChars - 1) * Rnd + 1)
        sGeneratedPwd = sGeneratedPwd & Replace(Chr(AllowedChars(iRndChar)), "'", "''")
    Next i

    GeneratePassword = sGeneratedPwd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: " & sModName & "/OfficenaGeneratePwd" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit

End Function

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

    If IsNull(Me.TextBoxNameOnForm) Or Me.TextBoxNameOnForm = "" Then
        Dim strRandomNumber As String
        strRandomNumber = GeneratePassword(8, True, True, True, False)
    
        Dim intRandomNumber As Integer
        intRandomNumber = DCount("FieldNameInTable", "TableName", "FieldNameInTable = '" & Replace(strRandomNumber, "'", "''") & "'")
        
        If intRandomNumber > 0 Then
            strRandomNumber = GeneratePassword(8, True, True, True, False)
        End If
    
        Me.TextBoxNameOnForm = strRandomNumber
    Else
    End If

الان فقط غير فى كود الاستدعاء التالى :

اسم مربع النص والذى تريد اظهار الرموز العشوائية بداخله و الموجود على النموذج بدلا من: Me.TextBoxNameOnForm
وغير اسم الجدول بدلا من : TableName
وغير اسم الحقل داخل الجدول والخاص بالرموز العشوائية بدلا من : FieldNameInTable

وطبعا انا بدأت كود الاستدعاء بأسلوب يجعل الرموز العشوائية لكل سجل فريدة ولا تتكرر يمكنك اما ازالتها او تركها حسب حاجتك

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

strRandomNumber = GeneratePassword(8, True, True, True, True)

**Foksh** · ديسمبر 30, 2024

54 دقائق مضت, ابو جودي said:

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

بعد أذن صاحب السعادة .. :wub:

مشاركة جانبية ، لكنها ليست بحجم مشاركة الهندسة @ابو جودي ..

جرب هذا الكود مع الدالة :-

Private Sub Date1_AfterUpdate()
Date2 = DateAdd("yyyy", 1, Date1)
    Dim expirationDate As Date
    Dim randomString As String
    expirationDate = DateAdd("yyyy", 1, Me.Date1.Value)
    Me.Date2.Value = expirationDate
    randomString = GenerateRandomString(8)
    Me.random_number = randomString
    Me.Dirty = False
End Sub

Private Function GenerateRandomString(length As Integer) As String
    Dim chars As String
    Dim i As Integer
    Dim result As String
    chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    result = ""
    For i = 1 To length
        result = result & Mid(chars, Int((Len(chars) * Rnd) + 1), 1)
    Next i
    GenerateRandomString = result
End Function

وجرب غير السنة في الحقل تاريخ الاصدار

New.accdb

**محمد التميمي** · ديسمبر 30, 2024

30 دقائق مضت, ابو جودي said:
الله يسلمك

شوف نظريا كده دى الاجابة

اعمل وحدة نمطية جديدة فى قاعدة البيانات بتاعتك واعطها مثلا الاسم : basGeneratorPassword
وضع بها الاكواد الاتية ...
Public Const DefaultLength As Integer = 10
Public Const DefaultSpecialChars As String = "'?,./<>|\[]{}:;#$%&()*+-@_""" & "!`~@#$%^&*()=€¥»«©®™°¢£•÷×¶"


Public Function GeneratePassword( _
                                    Optional Length As Integer = DefaultLength, _
                                    Optional bNumeric As Boolean = True, _
                                    Optional bUpperAlpha As Boolean = True, _
                                    Optional bLowerAlpha As Boolean = True, _
                                    Optional bSpecialChr As Boolean = True, _
                                    Optional sSpecialChr As String = DefaultSpecialChars) As String


    On Error GoTo Error_Handler

    Dim AllowedChars() As Variant
    Dim iCounter As Integer
    Dim i As Integer
    Dim iRndChar As Integer
    Dim iNoAllowedChars As Long
    Dim sGeneratedPwd As String
    Const sModName = "modGeneratorPassword"

    ' Initialize array
    ReDim AllowedChars(0)

    ' Numeric
    If bNumeric Then
        For i = 48 To 57
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Uppercase Alphabet
    If bUpperAlpha Then
        For i = 65 To 90
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Lowercase Alphabet
    If bLowerAlpha Then
        For i = 97 To 122
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Special Characters
    If bSpecialChr And Trim(sSpecialChr) <> "" Then
        For i = 1 To Len(sSpecialChr)
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = Asc(Mid$(sSpecialChr, i, 1))
        Next i
    End If

    ' Generate Password
    Randomize
    iNoAllowedChars = UBound(AllowedChars)
    For i = 1 To DefaultLength
        iRndChar = Int((iNoAllowedChars - 1) * Rnd + 1)
        sGeneratedPwd = sGeneratedPwd & Replace(Chr(AllowedChars(iRndChar)), "'", "''")
    Next i

    GeneratePassword = sGeneratedPwd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: " & sModName & "/OfficenaGeneratePwd" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit

End Function
الان انظر فى الحدث الذى تريد استدعاء الداله فيه وليكن مثلا بعد تحديث التاريخ حقل التاريخ ضع اسفل الاكواد التى استخدمتها هذه الاكواد
    If IsNull(Me.TextBoxNameOnForm) Or Me.TextBoxNameOnForm = "" Then
        Dim strRandomNumber As String
        strRandomNumber = GeneratePassword(8, True, True, True, False)
    
        Dim intRandomNumber As Integer
        intRandomNumber = DCount("FieldNameInTable", "TableName", "FieldNameInTable = '" & Replace(strRandomNumber, "'", "''") & "'")
        
        If intRandomNumber > 0 Then
            strRandomNumber = GeneratePassword(8, True, True, True, False)
        End If
    
        Me.TextBoxNameOnForm = strRandomNumber
    Else
    End If
الان فقط غير فى كود الاستدعاء التالى :

اسم مربع النص والذى تريد اظهار الرموز العشوائية بداخله و الموجود على النموذج بدلا من: Me.TextBoxNameOnForm
وغير اسم الجدول بدلا من : TableName
وغير اسم الحقل داخل الجدول والخاص بالرموز العشوائية بدلا من : FieldNameInTable

وطبعا انا بدأت كود الاستدعاء بأسلوب يجعل الرموز العشوائية لكل سجل فريدة ولا تتكرر يمكنك اما ازالتها او تركها حسب حاجتك

ملاحظة اضافيه ان اردت الرموز العشوائية تحتوى على رموز بجانب الارقام والاحرف الكبيرة والصغيرة فقط استدع الدالة بالشكل التالى
strRandomNumber = GeneratePassword(8, True, True, True, True)
احسنت احسنت استاذي الغالي ابا جودي بارك الله بك وجعله الله في ميزان حسناتك

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

New.accdb

14 دقائق مضت, Foksh said:
بعد أذن صاحب السعادة ..

مشاركة جانبية ، لكنها ليست بحجم مشاركة الهندسة @ابو جودي ..

جرب هذا الكود مع الدالة :-
Private Sub Date1_AfterUpdate()
Date2 = DateAdd("yyyy", 1, Date1)
    Dim expirationDate As Date
    Dim randomString As String
    expirationDate = DateAdd("yyyy", 1, Me.Date1.Value)
    Me.Date2.Value = expirationDate
    randomString = GenerateRandomString(8)
    Me.random_number = randomString
    Me.Dirty = False
End Sub

Private Function GenerateRandomString(length As Integer) As String
    Dim chars As String
    Dim i As Integer
    Dim result As String
    chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    result = ""
    For i = 1 To length
        result = result & Mid(chars, Int((Len(chars) * Rnd) + 1), 1)
    Next i
    GenerateRandomString = result
End Function
وجرب غير السنة في الحقل تاريخ الاصدار

New.accdb 476 kB · 2 downloads

شكرا جزيلا اخي الكريم Foksh ر على المرور اجابة الاستاذ ابا جودي مبهرة

**Foksh** · ديسمبر 30, 2024

13 دقائق مضت, محمد التميمي said:

اجابة الاستاذ ابا جودي مبهرة

لا شك في ذلك يا صديقي ، ولهذا السبب ارجو ان تنسب افضل إجابة للمشاركة التي حلت المشكلة وليس تعليقك السابق :wink2:

تسجيل الدخول

توليد ارقام وحروف عشوائية فريد لكل سجل عند تحديث التاريخ

الردود الموصى بها

محمد التميمي

ابو جودي

محمد التميمي

ابو جودي

محمد التميمي

ابو جودي

Foksh

محمد التميمي

Foksh

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information