اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

تغير لون الخليه التي عليها مؤشر الماوس مع بقاء الالوان الاساسية


إذهب إلى أفضل إجابة Solved by الـعيدروس,

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

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

كنترول صف خامس.xlsm

تم تعديل بواسطه كرار خالد
رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم

الخلايا التي بها الوان متدرجه لايجدي الكود معها

لاكن بخصوص اختلاف ارجاع الالوان كما سابقتها

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

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
MyColor = 6
If Not IsError(Sh.[N_Color_Rng]) Then
If Not IsError(Sh.[N_Color_Color]) Then
If Not IsError(Sh.[N_Color_Old]) Then
If Sh.[N_Color_Rng].Interior.ColorIndex = Sh.[N_Color_Old] Then
Dim R, G, B
R = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 1)
G = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 2)
B = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 3)
Sh.[N_Color_Rng].Interior.Color = RGB(R, G, B)
End If
End If
End If
End If
Sh.Names.Add "N_Color_Rng", ActiveCell
Sh.Names.Add "N_Color_Color", G_Colr(ActiveCell)
Sh.Names.Add "N_Color_Old", MyColor
ActiveCell.Interior.ColorIndex = MyColor
End Sub
Function Ref_Ali(a, Inx)
Select Case Inx
       Case 1
        aa = Mid(a, InStr(1, a, "(") + 1, InStr(InStr(1, a, "("), a, ",") - InStr(1, a, "(") - 1)
       Case 2
        aa = Split(a, ",")(1)
       Case 3
        aa = Mid(Trim(Split(a, ",")(2)), 1, InStr(1, Trim(Split(a, ",")(2)), ")") - 1)
End Select
Ref_Ali = aa
End Function
Function G_Colr(Rng As Range)
Dim HEX_A As String
Dim Ali_R As String
HEX_A = Right("000000" & Hex(Rng.Interior.Color), 6)
Ali_R = "RGB (" & CInt("&H" & Right(HEX_A, 2)) & ", " & CInt("&H" & Mid(HEX_A, 3, 2)) & ", " & CInt("&H" & Left(HEX_A, 2)) & ")"
G_Colr = Ali_R
End Function


 

  • Like 1
رابط هذا التعليق
شارك

الخلايا ذات الالوان المتدرجه لم تعمل مع الكود

فهمتني اما الخلايا التي بها لون عادي بتعمل بكفاءه

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

  • Like 1
رابط هذا التعليق
شارك

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.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information