السلام عليكم
نموذج/لوح/صندوق الألوان لاختيار اللون للخلفية أو النص بكود جديد مختصر وأفضل من السابق حيث كان الموجود سابقا لا يقف على اللون عند فتح النموذج واضطررت أن أتحايل بابتكار كود باستخدام عبارة 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