flashlabel طريقة وميض و تغيير عنوان مربع التسمية (Label) بعد الضغط على زر امر (CommandButton) بعنوان هذا الزر

[safaa salem5]

عندى اربع ازرار وليبل واحد

 عايزه عند الضغط على اى زرار منهم الزرار يتحول للون اصفر و الليبل يتحول لاسم الزرار ويعمل وميض بلون الزرار

CHANGE LABLE BY 4 BITTON.accdb

تم تعديل ديسمبر 16, 2023 بواسطه ابو جودي

[Foksh]

11 دقائق مضت, safaa salem5 said:

عندى اربع ازرار وليبل واحد

 عايزه عند الضغط على اى زرار منهم الزرار يتحول للون اصفر و الليبل يتحول لاسم الزرار ويعمل وميض بلون الزرار

CHANGE LABLE BY 4 BITTON.accdb 1.66 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 0 downloads

Private Sub button1_Click()
    ' تحديد اللون الأصفر لخلفية الزر
    Me.button1.BackColor = RGB(255, 255, 0)
    
    ' تحديد اللون الأصفر لخلفية الليبل
    Me.text1.BackColor = RGB(255, 255, 0)
    
    ' تحديد نص الليبل ليكون اسم الزر
    Me.text1.Caption = "button1"
    
    ' إعادة تعيين اللون والنص إلى الحالة الافتراضية بعد فترة زمنية قصيرة
    Me.Repaint
    Sleep 500
    Me.button1.BackColor = RGB(255, 255, 255)
    Me.text1.BackColor = RGB(255, 255, 255)
    Me.text1.Caption = "النص الافتراضي"
End Sub

حيث Button1 = اسم الزر

Text1 = اسم الليبل

[safaa salem5]

40 minutes ago, Foksh said:

Private Sub button1_Click()
    ' تحديد اللون الأصفر لخلفية الزر
    Me.button1.BackColor = RGB(255, 255, 0)
    
    ' تحديد اللون الأصفر لخلفية الليبل
    Me.text1.BackColor = RGB(255, 255, 0)
    
    ' تحديد نص الليبل ليكون اسم الزر
    Me.text1.Caption = "button1"
    
    ' إعادة تعيين اللون والنص إلى الحالة الافتراضية بعد فترة زمنية قصيرة
    Me.Repaint
    Sleep 500
    Me.button1.BackColor = RGB(255, 255, 255)
    Me.text1.BackColor = RGB(255, 255, 255)
    Me.text1.Caption = "النص الافتراضي"
End Sub

حيث Button1 = اسم الزر

Text1 = اسم الليبل

بيدينى لون ازرق على sleep500

[Foksh]

9 دقائق مضت, safaa salem5 said:

sleep500

استبدلي بعذا الكود ،

Private Sub button1_Click()
    ' تحديد اللون الأصفر لخلفية الزر
    Me.button1.BackColor = RGB(255, 255, 0)
    
    ' تحديد اللون الأصفر لخلفية الليبل
    Me.text1.BackColor = RGB(255, 255, 0)
    
    ' تحديد نص الليبل ليكون اسم الزر
    Me.text1.Caption = "button1"
    
    ' إعادة تعيين اللون والنص إلى الحالة الافتراضية بعد فترة زمنية قصيرة
    Me.Repaint
    DoEvents  ' تمكين تنفيذ الأحداث الأخرى
    Application.Wait Now + TimeValue("0:00:01")  ' تأخير لمدة ثانية واحدة
    Me.button1.BackColor = RGB(255, 255, 255)
    Me.text1.BackColor = RGB(255, 255, 255)
    Me.text1.Caption = "النص الافتراضي"
End Sub

 

أو راجعي هذه المشاركة لحل هذه المشكلة Sleep😊

تم تعديل ديسمبر 15, 2023 بواسطه Foksh

[safaa salem5]

Just now, Foksh said:

راجعي هذه المشاركة لحل هذه المشكلة 😊

احط الرقم دا فى

time 

الخاص بالفورم

[Foksh]

2 دقائق مضت, safaa salem5 said:

احط الرقم دا فى

time 

الخاص بالفورم

لأ ،

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub TestSleep()
    ' انتظار لمدة 1000 مللي ثانية (واحدة ثانية)
    Sleep 1000
End Sub

ضعي هذا الكود في بداية الأكواد ،

واعذروني لعدم توافر جهاز كمبيوتر في الوقت الحالي لتطبيق الأكواد على المرفقات 😊

[safaa salem5]

22 minutes ago, Foksh said:

لأ ،

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub TestSleep()
    ' انتظار لمدة 1000 مللي ثانية (واحدة ثانية)
    Sleep 1000
End Sub

ضعي هذا الكود في بداية الأكواد ،

واعذروني لعدم توافر جهاز كمبيوتر في الوقت الحالي لتطبيق الأكواد على المرفقات 😊

عملت كدا بيدى رسالة خطأ

[Foksh]

8 دقائق مضت, safaa salem5 said:

عملت كدا بيدى رسالة خطأ

يبقى هشوف الكود وازبطه بس اوصل الكمبيوتر 

[ابو جودي]

الموضوع تعبنى جدا والله وكان تحدى صعب
احب التنويه الى شئ
استخدام sleep اثناء العمل قد يصيب الأكسس بالتجميدوالشلل وقد يعلق فى الذاكرة
ولذلك ابتعدت عن ضبط الاكواد من خلالها 
واليكم نتيجة  التحدى

اولا تم مراعاة وضع الاكواد فى وحدة نمطية ليتم استخدامها فى اكثر من نموذج حتى لو اختلف  وتعددت الوان أزرار الأوامر ومهما اختلفت اسماء او عناوين الأزرار
وفى حاجة كمان لو عاوزيين نلون لون الزرار بالاصفر بس ومنغيرش تسمية عنصر التسمية ممكن جدا جدا ومن نفس الكود

يعنى كود ذكى وابن حلال وبيقدر يفهمنا من أول تكه على الزرار اه والله زيمبئولكم كده.. شغل فاخر من الاخر   اومااااااااااال 

1- أكواد الوحدة النمطية
 

Option Compare Database
Option Explicit

' Constant that specifies the time interval for color flashing (in seconds)
Const dblTimeInterval As Double = 0.5

' Constant that determines the number of times the colors will flash
Const intFlashCount As Integer = 5

' Variable to track whether Label flashing should occur
Public AllowFlashing

' Public variables to store default values
Public btnControlDefaultColor As Long
Public lblControlDefaultColor As Long
Public strLblControlCaption As String

Public formIsClosing As Boolean

' Public variable to store the selected button
Public selectedButton As CommandButton

' Function to return the highlighted color
Function ApplyHighlighted() As Long
    ApplyHighlighted = RGB(255, 255, 0)
End Function

' Subroutine to set the button color
Sub ButtonColor(ByVal frm As Form, Optional btn As CommandButton = Nothing, Optional DisableLabelChange As Boolean)
    ' Set the default button color if not highlighted
    If Not btn Is Nothing Then
        If btn.BackColor <> ApplyHighlighted Then btnControlDefaultColor = btn.BackColor

        ' Clear the previous button's highlight
        If Not selectedButton Is Nothing Then
            selectedButton.BackColor = btnControlDefaultColor
        End If

        ' Set the new button as selected and highlight it
        btn.BackColor = ApplyHighlighted

        ' Save the caption of the current button
        If Not DisableLabelChange Then
            strLblControlCaption = btn.Caption
        End If

        Set selectedButton = btn
    End If
End Sub

' Subroutine to flash the label control
Sub FlashLabelControl(frm As Form, lblControl As Object, DisableLabelChange As Boolean)
    On Error GoTo ErrorHandler

    Dim flashingColor As Long
    Dim flashingInterval As Single
    Dim flashCount As Integer
    Dim flashTimer As Single
    Dim i As Integer

    On Error GoTo 0 ' Turn off error trapping.
    On Error Resume Next ' Defer error trapping.

    ' Set the default label color if not highlighted
    If lblControl.BackColor <> ApplyHighlighted Then lblControlDefaultColor = lblControl.BackColor

    flashingColor = ApplyHighlighted
    flashingInterval = dblTimeInterval
    flashCount = intFlashCount

    ' Reset the label color to the default when the form is loaded
    If TypeOf lblControl Is Access.Label And Not formIsClosing Then
        lblControl.BackColor = lblControlDefaultColor
        If Not DisableLabelChange Then
            lblControl.Caption = strLblControlCaption
        End If
    End If

    flashTimer = Timer + flashingInterval

    ' Flash the label color
    For i = 1 To flashCount
        Do While Timer < flashTimer And Not formIsClosing
            DoEvents
        Loop

        ' Update the label color during the flash
        If TypeOf lblControl Is Access.Label And Not formIsClosing Then
            If AllowFlashing Then
                ' Check the AllowLabelCaptionChange value to determine whether to change the caption
                If Not DisableLabelChange Then
                    lblControl.Caption = IIf(lblControl.Caption = strLblControlCaption, strLblControlCaption, vbNullString)
                End If
                lblControl.BackColor = IIf(lblControl.BackColor = lblControlDefaultColor, flashingColor, lblControlDefaultColor)
            End If
        End If

        ' Update the flash timer
        flashTimer = Timer + flashingInterval
    Next i
    
    ' Reset the label color to the default after flashing
    If TypeOf lblControl Is Access.Label And Not formIsClosing Then
        lblControl.BackColor = lblControlDefaultColor
        If Not DisableLabelChange Then
            lblControl.Caption = strLblControlCaption
        End If
    End If

    ' 2467
    Err.Clear ' Clear Err
    Exit Sub ' Exit to avoid handler.

ErrorHandler: ' Error-handling routine.
    Select Case Err.Number ' Evaluate error number.
        Case Is = 2467
            flashCount = 0
            flashTimer = 0
            Exit Sub ' Exit to avoid handler.
        Case Else
            ' Handle other situations here...
            MsgBox Err.Number & ": " & Err.Description
            Resume ' Resume execution at the same line
    End Select
End Sub

' Subroutine to change the button color and control Label flashing
Sub ChangeCommandButtonColor(frm As Form, Optional lblControl As Object, Optional DisableLabelChange As Boolean)
    On Error GoTo ErrorHandler

    Dim clickedButton As CommandButton
    Set clickedButton = frm.ActiveControl

    On Error GoTo 0 ' Turn off error trapping.
    On Error Resume Next ' Defer error trapping.

    ' Clear the previous button's highlight
    If Not selectedButton Is Nothing Then
        selectedButton.BackColor = btnControlDefaultColor
        lblControl.Caption = ""
        strLblControlCaption = ""
    End If

    ' Set the new button as selected and highlight it
    Set selectedButton = clickedButton

    ' Update the label caption
    If Not DisableLabelChange Then
        strLblControlCaption = clickedButton.Caption
    End If

    ' Apply the button color and control Label flashing
    ButtonColor frm, clickedButton, True

    ' Check if lblControl is provided and is a valid object
    If Not lblControl Is Nothing Then
        AllowFlashing = Not DisableLabelChange  ' Determine whether to trigger flashing
        lblControl.Caption = strLblControlCaption
        FlashLabelControl frm, lblControl, False
    End If

    Err.Clear ' Clear Err
    Exit Sub ' Exit to avoid handler.

ErrorHandler: ' Error-handling routine.
    Select Case Err.Number ' Evaluate error number.
        Case Is = 5
            Exit Sub ' Exit to avoid handler.
        Case Else
            ' Handle other situations here...
            MsgBox Err.Number & ": " & Err.Description
            Resume ' Resume execution at the same line
    End Select

End Sub

 2- الاكواد للاستخدام من خلال النموذج ولا اسهل من كده..  يا عينى ع الدلع
 

Private Sub Form_Load()
formIsClosing = False
End Sub

Private Sub Form_Close()
  formIsClosing = True
End Sub

Private Sub Command1_Click()
    ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle).
    ChangeCommandButtonColor Me, Me.lblDisplayTitle
End Sub

Private Sub Command2_Click()
    ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle).
    ChangeCommandButtonColor Me, Me.lblDisplayTitle
End Sub

Private Sub Command3_Click()
    ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle).
    ChangeCommandButtonColor Me, Me.lblDisplayTitle
End Sub

Private Sub Command4_Click()
    ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle).
    ChangeCommandButtonColor Me, Me.lblDisplayTitle
End Sub

Private Sub Command5_Click()
    ' Call the ChangeCommandButtonColor subroutine with the current form only without label control (lblDisplayTitle).
    ' To disable Allow Label Caption Change = True
    ChangeCommandButtonColor Me, Me.lblDisplayTitle, True
End Sub

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

بس خلاص 

• وأخيرا المرفق
 

FlashLabel.accdb

[Foksh]

3 ساعات مضت, ابو جودي said:

لموضوع تعبنى جدا والله وكان تحدى صعب

عمل جميل جداً منك أستاذنا الكبير @ابو جودي 

ولكن واجهتني مشكلة غريبة ، ارفقتها في فيديو لتتضح ؛ هل من تفسير ؟؟

2023_12_16_145730.zip

[Moosak]

5 ساعات مضت, ابو جودي said:

الموضوع تعبنى جدا والله وكان تحدى صعب

ما شاء الله عليك يا كبيييييييييير .... عملتها بطريقة المعلمين 😅👌🏼

الجهد واضح جدا جدا .. تبارك الله ..

دايما ميزتك تعمل حل متكامل لكل الأزمان  👍🏻😊

بارك الله لنا فيك وبارك الله في علمك ونفع بك  🤲🏻

2 ساعات مضت, Foksh said:

واجهتني مشكلة غريبة

العم @Foksh

أعتقد السبب أنك نقلت الملف من مكان آمن موثوق لمكان مش موثوق بعد 🙂 

إدعس باليمين على الملف وألغ الحضر .. 🙃👇🏻 :

[Foksh]

7 دقائق مضت, Moosak said:

أعتقد السبب أنك نقلت الملف من مكان آمن موثوق لمكان مش موثوق بعد 🙂 

 

ملغي والله 

[ابو جودي]

4 ساعات مضت, Foksh said:

ولكن واجهتني مشكلة غريبة ، ارفقتها في فيديو لتتضح ؛ هل من تفسير ؟؟

 

شوف يا سيدى

خلينا نتفق ان انا موافق تسألنى ونتناقش عادى والله 

ممكن تسألنى انت ليه معقد ومكلكع 

على قلبى زى العسل 

انما تسألنى عن شغل عفاريت

اهو ده اللى لا يمكن اسمح بيه ابدا 

انت جاى تهزر يا عم الحاج 

الحل بسيط وابسط من البساطه اشتغل من ع الديسك توب يا بيه .. اتفضل على هناك مفيش بخور  هنا 

[Foksh]

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

انما تسألنى عن شغل عفاريت

 

بخرت والله ، 

وانا برضو استغربت ، وقلت بنفسي يمكن العمل مربوط بالديسك توب  

على العموم جزاك الله خير ، وما كنت أشكك في عملك ، ولكن كحالة استغربت بس 

[ابو جودي]

9 دقائق مضت, Foksh said:

بخرت والله ، 

وانا برضو استغربت

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

 

12 دقائق مضت, Foksh said:

ولكن كحالة استغربت بس 

وده شكلك وانت مستغرب ؟.   
ده اسبهلال مش استغراب ده
 

11 دقائق مضت, Foksh said:

وقلت بنفسي يمكن العمل مربوط بالديسك توب  

اكيد مفيش حاجه زى كده يعنى
 

13 دقائق مضت, Foksh said:

وما كنت أشكك في عملك

لا يا اخويه شكك براحتك.. ارحم من العفرته اللى ورتها لنا دى

14 دقائق مضت, Foksh said:

جزاك الله خير

وجزاكم الله  

 

 

[ابو جودي]

طيب يا استاذه @safaa salem5
المرفق شغال مع حضرتك تمام واللا فى مشاكل ؟

وهل ده المطلوب واللا لا

[ابو جودي]

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

بس بغض النظر عن اللى فات ده هاختار افضل اجابه لنفسى  اومااااااااااال