اذهب الي المحتوي
أوفيسنا

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

قام بنشر (معدل)

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

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

CHANGE LABLE BY 4 BITTON.accdbFetching info...

تم تعديل بواسطه ابو جودي
قام بنشر
  في 15‏/12‏/2023 at 16:37, safaa salem5 said:

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

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

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

Expand  
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 = اسم الليبل

قام بنشر
  في 15‏/12‏/2023 at 16:49, 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 = اسم الليبل

Expand  

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

قام بنشر (معدل)
  في 15‏/12‏/2023 at 17:30, safaa salem5 said:

sleep500

Expand  

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

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😊

تم تعديل بواسطه Foksh
قام بنشر
  في 15‏/12‏/2023 at 17:40, safaa salem5 said:

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

time 

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

Expand  

لأ ،

#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

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

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

قام بنشر
  في 15‏/12‏/2023 at 17:45, 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

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

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

Expand  

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

  • تمت الإجابة
قام بنشر

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

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

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

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


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

بس خلاص :eek2:

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

FlashLabel.accdbFetching info...

  • Like 5
  • Thanks 1
  • Haha 1
قام بنشر
  في 16‏/12‏/2023 at 08:56, ابو جودي said:

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

Expand  

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

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

2023_12_16_145730.zipFetching info...

قام بنشر
  في 16‏/12‏/2023 at 08:56, ابو جودي said:

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

Expand  

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

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

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

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

  في 16‏/12‏/2023 at 12:01, Foksh said:

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

Expand  

العم @Foksh

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

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

image.png.5d86029bac27e45ab92fa124f2cceb3b.png

قام بنشر
  في 16‏/12‏/2023 at 14:44, Moosak said:

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

 

Expand  

ملغي والله :')

قام بنشر
  في 16‏/12‏/2023 at 12:01, Foksh said:

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

 

Expand  

شوف يا سيدى

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

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

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

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

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

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

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

  • Haha 1
قام بنشر
  في 16‏/12‏/2023 at 16:42, ابو جودي said:

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

 

Expand  

بخرت والله ، :biggrin:

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

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

قام بنشر
  في 16‏/12‏/2023 at 16:46, Foksh said:

بخرت والله ، :biggrin:

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

Expand  

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

 

  في 16‏/12‏/2023 at 16:46, Foksh said:

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

Expand  

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

  في 16‏/12‏/2023 at 16:46, Foksh said:

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

Expand  

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

  في 16‏/12‏/2023 at 16:46, Foksh said:

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

Expand  

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

  في 16‏/12‏/2023 at 16:46, Foksh said:

جزاك الله خير

Expand  

وجزاكم الله  :fff:

 

 

  • Haha 1
  • 2 weeks later...
قام بنشر

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

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

  • Haha 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information