فورم لتوليد أرقام عشوائية ما بين رقمين مع الاحتفاظ بقيم البداية والنهاية في الريجستري

[ياسر خليل أبو البراء]

السلام عليكم ورحمة الله وبركاته

إخواني الكرام وأحبابي في الله

أقدم لكم فورم يقوم بتوليد أرقام عشوائية ما بين رقمين ..

الجديد في الموضوع أن الأرقام التي يتم تحديدها كأرقام البداية والنهاية يحتفظ بها في ملف الريجستري ..أي إذا أغلقت المصنف وفتحته مرة أخرى ستجد آخر أرقام تم تسجيلها ومحتفظ بها

على سبيل المثال ..أول ما تشغل الفورم يكون رق البداية 1 ورقم النهاية 100 .. قم بتغيير الرقم 1 إلى 5 والرقم 100 إلى 200 ... ونفذ الكود واخرج من الفورم وأغلق المصنف وأعد فتحة مرة أخرى .. ستجد أن الأرقام الأخيرة 5 ، 200 تم الاحتفاظ بهما

أرجو أن ينال الفورم إعجابكم

الكود التالي يوضع في موديول

Public Const PUPNAME As String = "Officena Forums"
Public Const APPNAME As String = "Random Number Generator"

Sub GetRandomNumber()
    With UserForm1
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
        .Show
    End With
End Sub

والكود التالي يوضع في حدث الفورم

Option Explicit

Dim Stopped As Boolean
Dim Cnt As Long

Private Sub UserForm_Initialize()
    On Error Resume Next
    Label1.BackColor = ActiveWorkbook.Theme.ThemeColorScheme(msoThemeDark2).RGB
    On Error GoTo 0
    Me.Caption = APPNAME
    If GetSetting(PUPNAME, "Settings", "RememberSettings", True) Then
        TextBox1.Text = GetSetting(PUPNAME, APPNAME, "TextBox1", 1)
        TextBox2.Text = GetSetting(PUPNAME, APPNAME, "TextBox2", 100)
    End If
End Sub

Private Sub StartStopButton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Start_Or_Stop
End Sub

Private Sub StartStopButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    '"S" Keys Starts And Stops
    If KeyCode = 83 Then Call Start_Or_Stop
End Sub

Private Sub Start_Or_Stop()
    Dim Low As Double, Hi As Double
    
    If StartStopButton.Caption = "Start" Then
        LabelNumberCount.Visible = False
        
        'Validate Low And High Values
        If Not IsNumeric(TextBox1.Text) Then
            MsgBox "Non-Numeric Starting Value.", vbInformation, APPNAME
            With TextBox1
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
            Exit Sub
        End If
        
        If Not IsNumeric(TextBox2.Text) Then
            MsgBox "Non-Numeric Ending Value.", vbInformation, APPNAME
            With TextBox2
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
            Exit Sub
        End If
        
        'Make Sure They Aren't In The Wrong Order
        Low = Application.Min(Val(TextBox1.Text), Val(TextBox2.Text))
        Hi = Application.Max(Val(TextBox1.Text), Val(TextBox2.Text))
        
        'Adjust Font Size If Necessary
        Select Case Application.Max(Len(TextBox1.Text), Len(TextBox2.Text))
            Case Is < 5: Label1.Font.Size = 72
            Case 5: Label1.Font.Size = 60
            Case 6: Label1.Font.Size = 48
            Case Else: Label1.Font.Size = 36
        End Select
        
        StartStopButton.Caption = "Stop"
        Stopped = False
        Randomize
        Cnt = 0
        Do Until Stopped
            Label1.Caption = Int((Hi - Low + 1) * Rnd + Low)
            Cnt = Cnt + 1
            DoEvents
        Loop
    Else
        Stopped = True
        StartStopButton.Caption = "Start"
        With LabelNumberCount
            .Visible = True
            .Caption = Cnt
        End With
    End If
End Sub

Private Sub CancelButton_Click()
    Stopped = True
    Unload Me
End Sub

Private Sub UserForm_Terminate()
    Stopped = True
    SaveSetting PUPNAME, APPNAME, "TextBox1", TextBox1.Text
    SaveSetting PUPNAME, APPNAME, "TextBox2", TextBox2.Text
    On Error GoTo 0
    Unload Me
End Sub

Private Sub PUPHelpButton_Click()
    MsgBox "Random Number Generator By YasserKhalil From Officena", 64
End Sub

وإليكم الملف المرفق مطبق فيه الأكواد ... عسى أن ينال إعجابكم

تقبلوا تحياتي

حمل الملف من هنا

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

بارك الله فيك أخي الغالي "ياسر خليل أبو البراء" على الهدايا الثمينة التي طالما تتحفنا بها

جزاك الله خيرًا و زادك من علمه و فضله

فائق إحتراماتي

 

 

 

[ياسر خليل أبو البراء]

وعليكم السلام ورحمة الله وبركاته

أخي وحبيبي عبد العزيز البسكري

يسعدني أن تكون أول من يرد على الموضوع ومشكور على مرورك العطر بالموضوع

 

وأرجو أن يستفيد منه الجميع ...

طبعاً الكود ليس لي .. ولن تجده في مواقع الانترنت هي دي المعادلة الصعبة!!

(يرجى من الأخوة عمل بحث في الموضوع .. ليدلوني على المواقع التي تناولت الموضوع) لمزيد من الاستفادة

تقبلوا تحياتي

[عمرو.محمد]

-اولا بارك الله فيك على المجهود وبارك لك فى علمك.

-ثانيا ارجو المساعدة فى هذا الطلب حيث يشكل لى اهمية كبيرة وجزاكم الله كل خير اخوانى الكرام.

 

[أبوبسمله]

جزاك الله كل خير يا ابوالبراء

 

[ياسر خليل أبو البراء]

أخي الكريم عمرو محمد

مشكور على مرور العطر بالموضوع

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

 

أخي الحبيب أحمد الفلاحجي

وجزيت خيراً بمثل ما دعوت لي وزيادة .. وشرفت الموضوع بمرورك الكريم

تقبلوا تحياتي

[ياسر خليل أبو البراء]

هل تبرع أحدكم لعمل بحث في الموضوع لمزيد من الاستفادة؟

[ياسر خليل أبو البراء]

في ٢‏/٣‏/٢٠١٦ at 15:10, ياسر خليل أبو البراء said:

هل تبرع أحدكم لعمل بحث في الموضوع لمزيد من الاستفادة؟

لا استجابة لموضوعات البحث !

[عبدالعزيزالمدني]

في ‏٠١‏/‏٠٣‏/‏٢٠١٦ at 12:21, ياسر خليل أبو البراء said:

السلام عليكم ورحمة الله وبركاته

إخواني الكرام وأحبابي في الله

أقدم لكم فورم يقوم بتوليد أرقام عشوائية ما بين رقمين ..

الجديد في الموضوع أن الأرقام التي يتم تحديدها كأرقام البداية والنهاية يحتفظ بها في ملف الريجستري ..أي إذا أغلقت المصنف وفتحته مرة أخرى ستجد آخر أرقام تم تسجيلها ومحتفظ بها

على سبيل المثال ..أول ما تشغل الفورم يكون رق البداية 1 ورقم النهاية 100 .. قم بتغيير الرقم 1 إلى 5 والرقم 100 إلى 200 ... ونفذ الكود واخرج من الفورم وأغلق المصنف وأعد فتحة مرة أخرى .. ستجد أن الأرقام الأخيرة 5 ، 200 تم الاحتفاظ بهما

أرجو أن ينال الفورم إعجابكم

الكود التالي يوضع في موديول

Public Const PUPNAME As String = "Officena Forums"
Public Const APPNAME As String = "Random Number Generator"

Sub GetRandomNumber()
    With UserForm1
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
        .Show
    End With
End Sub

والكود التالي يوضع في حدث الفورم

Option Explicit

Dim Stopped As Boolean
Dim Cnt As Long

Private Sub UserForm_Initialize()
    On Error Resume Next
    Label1.BackColor = ActiveWorkbook.Theme.ThemeColorScheme(msoThemeDark2).RGB
    On Error GoTo 0
    Me.Caption = APPNAME
    If GetSetting(PUPNAME, "Settings", "RememberSettings", True) Then
        TextBox1.Text = GetSetting(PUPNAME, APPNAME, "TextBox1", 1)
        TextBox2.Text = GetSetting(PUPNAME, APPNAME, "TextBox2", 100)
    End If
End Sub

Private Sub StartStopButton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call Start_Or_Stop
End Sub

Private Sub StartStopButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    '"S" Keys Starts And Stops
    If KeyCode = 83 Then Call Start_Or_Stop
End Sub

Private Sub Start_Or_Stop()
    Dim Low As Double, Hi As Double
    
    If StartStopButton.Caption = "Start" Then
        LabelNumberCount.Visible = False
        
        'Validate Low And High Values
        If Not IsNumeric(TextBox1.Text) Then
            MsgBox "Non-Numeric Starting Value.", vbInformation, APPNAME
            With TextBox1
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
            Exit Sub
        End If
        
        If Not IsNumeric(TextBox2.Text) Then
            MsgBox "Non-Numeric Ending Value.", vbInformation, APPNAME
            With TextBox2
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
            Exit Sub
        End If
        
        'Make Sure They Aren't In The Wrong Order
        Low = Application.Min(Val(TextBox1.Text), Val(TextBox2.Text))
        Hi = Application.Max(Val(TextBox1.Text), Val(TextBox2.Text))
        
        'Adjust Font Size If Necessary
        Select Case Application.Max(Len(TextBox1.Text), Len(TextBox2.Text))
            Case Is < 5: Label1.Font.Size = 72
            Case 5: Label1.Font.Size = 60
            Case 6: Label1.Font.Size = 48
            Case Else: Label1.Font.Size = 36
        End Select
        
        StartStopButton.Caption = "Stop"
        Stopped = False
        Randomize
        Cnt = 0
        Do Until Stopped
            Label1.Caption = Int((Hi - Low + 1) * Rnd + Low)
            Cnt = Cnt + 1
            DoEvents
        Loop
    Else
        Stopped = True
        StartStopButton.Caption = "Start"
        With LabelNumberCount
            .Visible = True
            .Caption = Cnt
        End With
    End If
End Sub

Private Sub CancelButton_Click()
    Stopped = True
    Unload Me
End Sub

Private Sub UserForm_Terminate()
    Stopped = True
    SaveSetting PUPNAME, APPNAME, "TextBox1", TextBox1.Text
    SaveSetting PUPNAME, APPNAME, "TextBox2", TextBox2.Text
    On Error GoTo 0
    Unload Me
End Sub

Private Sub PUPHelpButton_Click()
    MsgBox "Random Number Generator By YasserKhalil From Officena", 64
End Sub

وإليكم الملف المرفق مطبق فيه الأكواد

تقبلوا تحياتي

Random Number Generator UserForm YasserKhalil.rar

جزاك الله خير الجزاء أستاذ ياسر نحتاج مثل هذا الكود لوضع الأرقام  اثناء المسابقات والاختيار العشوائي ولكن هل يمكن الاحتفاظ بالاختيارات السابقه

تم تعديل مارس 12, 2016 بواسطه عبدالعزيزالمدني

[ياسر خليل أبو البراء]

أخي الكريم عبد العزيز المدني

ركز على الجمل GetSetting و SaveSetting .. قم بعمل بحث على جوجل لهذه الكلمات وجمع موضوع وقدمه بأسلوبك ليستفيد الجميع

تقبل تحياتي

[عبدالعزيزالمدني]

الأستاذ ياسر خليل أبو البراء  عندنا مثل يقول ( ما قدر للعجل قال حمله امه  ) انا ما أقدر اقرأ الكلمات الإنجليزي اللي كتبتها فضلا عن عمل بحث فيها وبصراحه احرجتنا امام الناس

[ياسر خليل أبو البراء]

بل أنت لها أخي الحبيب عبد العزيز

حاول وافشل يكفيك شرف المحاولة ، لا تيأس أبداً

قم بعمل بحث ولو مبسط عن الأمر حتى تتكون لديك فكرة عن الموضوع ، اكتب باللغة العربية حفظ في الريجستري باستخدام excel vba لعل وعسى تجد مبتغاك

الموضوع محتاج لبحث طويل والوقت لا يسعني في حقيقة الأمر

وبعدين مفيش إحراج في التعلم ، فأنا ما زلت أتعلم وكل يوم اتعلم شيء جديد

العلم ليس له حدوووووووووووووووووووووووووووووووووووووووووووووود

[ياسر خليل أبو البراء]

طلبت عمل بحث بخصوص هذا الفورم ولم يتبرع أحد بالتقدم لعمل بحث ... أريد أن أستفزكم لتعرفوا أين تجدون الدرر ...؟

ولكن هذا الموضوع بالذات صعب الحصول على الكنوز والدرر حيث أن الملف نادر

[جلال الجمال_ابو أدهم]

ما شاء الله عليك ولا الاستوب ووتش

[ياسر خليل أبو البراء]

بارك الله فيك أخي العزيز جلال الجمال وجزاكم الله خيراً على مروركم العطر بالموضوع

تقبل تحياتي