فتح نموذج الألوان بطريقة أسهل

[أبو هادي]

السلام عليكم

نموذج/لوح/صندوق الألوان لاختيار اللون للخلفية أو النص بكود جديد مختصر وأفضل من السابق حيث كان الموجود سابقا لا يقف على اللون عند فتح النموذج واضطررت أن أتحايل بابتكار كود باستخدام عبارة Sendkeys ولكنه يفشل أحيانا لاختلاف لغة لوحة المفاتيح ، ولكنه الآن دون تحايل يقف على اللون مباشرة .

وهذه هي الدالة السابقة لحل المشكلة :

Sub Colors(Clr As Long, ByRef Row As Byte, ByRef Col As Byte)
  '-- Abo Hadi Feb 2, 2005
  Dim C
  C = Array(8421631, 8454143, 8454016, 8453888, 16777088, 16744448, 12615935, 16744703, _
            255, 65535, 65408, 4259584, 16776960, 12615680, 12615808, 16711935, _
            4210816, 4227327, 65280, 8421376, 8404992, 16744576, 4194432, 8388863, _
            128, 33023, 32768, 4227072, 16711680, 10485760, 8388736, 16711808, _
            64, 16512, 16384, 4210688, 8388608, 4194304, 4194368, 8388672, _
            0, 32896, 4227200, 8421504, 8421440, 12632256, 4194368, 16777215, -1)
  Dim K As Byte
  
  For K = 0 To 48
    If Clr = C(K) Then Exit For
  Next K

  If K < 48 Then
    Row = (K + 8) \ 8
    Col = (K + 1) Mod 8: If Col = 0 Then Col = 8
    
    Row = 6 - Row  '-- steps to move right
    Col = Col - 1  '-- steps to move up
  End If
End Sub

تحياتي .

DialogColor.rar

[فهد الدوسري]

يعطيك العافية يا مبدع