انتقل إلى المحتوى الرئيسي

كيفية تطبيق التدرج اللوني عبر خلايا متعددة؟

في Excel ، يمكننا بسهولة ملء لون الخلفية لخلية أو عدة خلايا ، ولكن في بعض الأحيان ، نحتاج إلى ملء اللون بالتدرج كما هو موضح في لقطة الشاشة التالية ، كيف يمكن الحصول على تدرج اللون في خلية أو عبر خلايا متعددة في Excel؟

التدرج اللوني لخلية واحدة التدرج اللوني عبر خلايا متعددة
التدرج اللوني للوثيقة 1 التدرج اللوني للوثيقة 2

قم بتطبيق لون متدرج على خلية واحدة باستخدام ميزة تنسيق الخلايا

قم بتطبيق لون متدرج عبر خلايا متعددة باستخدام كود VBA


السهم الأزرق الحق فقاعة قم بتطبيق لون متدرج على خلية واحدة باستخدام ميزة تنسيق الخلايا

في Excel ، يمكن أن تساعدك ميزة تنسيق الخلايا على ملء التدرج اللوني في خلية واحدة ، يرجى القيام بما يلي:

1. حدد خلية أو خلايا متعددة تريد تعبئتها بتدرج لوني لكل خلية ، ثم انقر بزر الماوس الأيمن للاختيار تنسيق الخلايا من قائمة السياق ، في تنسيق الخلايا مربع الحوار ، تحت شغل علامة التبويب ، الرجاء الضغط تأثيرات التعبئة زر ، انظر لقطة الشاشة:

التدرج اللوني للوثيقة 3

2. في تأثيرات التعبئة الحوار ، حدد لونين تريد استخدامهما من القائمتين المنسدلتين الألوان ، ثم حدد أحد أنماط التظليل كما تريد ، مثل أفقي وعمودي وما إلى ذلك. انظر لقطة الشاشة:

التدرج اللوني للوثيقة 4

3. ثم اضغط OK > OK لإغلاق مربعات الحوار ، ويتم تعبئة لون التدرج لكل خلية كما هو موضح في لقطة الشاشة التالية:

التدرج اللوني للوثيقة 5


السهم الأزرق الحق فقاعة قم بتطبيق لون متدرج عبر خلايا متعددة باستخدام كود VBA

يمكن أن تساعدنا الطريقة أعلاه على التدرج اللوني داخل خلية فردية ، إذا كنت بحاجة إلى تظليل التدرج اللوني عبر خلايا متعددة ، فأنت بحاجة إلى تطبيق رمز VBA لحلها.

1. أولاً ، قم بتعبئة لون خلفية معين في نطاق من الخلايا.

2. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

3. انقر إدراج > وحدة، والصق الكود التالي في ملف وحدة نافذة او شباك.

كود فبا: تطبيق لون متدرج عبر خلايا متعددة:

Sub colorgradientmultiplecells()
'Updateby Extendoffcie 
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xColor As Long
    Dim I As Long
    Dim K As Long
    Dim xCount As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
LInput:
    Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"
        GoTo LInput
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    xCount = xRg.Rows.Count
    For K = 1 To xRg.Columns.Count
        xColor = xRg.Cells(1, K).Interior.Color
        For I = xCount To 1 Step -1
            xRg.Cells(I, K).Interior.Color = xColor
            xRg.Cells(I, K).Interior.TintAndShade = (xCount - (I - 1)) / xCount
        Next
    Next
End Sub

4. ثم اضغط F5 مفتاح لتشغيل هذا الرمز ، ويظهر مربع موجه لتذكيرك بتحديد الخلايا الملونة التي تريد أن تملأ لون التدرج ، انظر الصورة:

 

التدرج اللوني للوثيقة 6

5. ثم انقر فوق OK الزر ، تم عرض اللون داخل خلايا متعددة كلون متدرج ، انظر لقطة الشاشة:

 

التدرج اللوني للوثيقة 7

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (24)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Thanks for the awesome code.

How do I make the gradient go from colour to white top to bottom?
How would i choose between two colours?
This comment was minimized by the moderator on the site
Hello, Tra,
For the first question, to make the gradient go from color to white top to bottom, please apply the following code:
Sub colorgradientmultiplecells()
'Updateby Extendoffcie
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xColor As Long
Dim I As Long
Dim K As Long
Dim xCount As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput:
Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Areas.Count > 1 Then
MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"
GoTo LInput
End If
On Error Resume Next
Application.ScreenUpdating = False
xCount = xRg.Rows.Count
For K = 1 To xRg.Columns.Count
xColor = xRg.Cells(1, K).Interior.Color
For I = xCount To 1 Step -1
xRg.Cells(I, K).Interior.Color = xColor
xRg.Cells(I, K).Interior.TintAndShade = I / xCount
Next
Next
End Sub


For the second question, to fill the gradient with two colors, please apply the belwo code:
Note: to change the two colors, you just need to change the RGB in the code.
Sub colorgradientmultiplecells()
    'Updateby Extendoffcie
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xColor1 As Long
    Dim xColor2 As Long
    Dim I As Long
    Dim K As Long
    Dim xCount As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
        xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
        xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
LInput:
    Set xRg = Application.InputBox("Please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "Does not support multiple selections", vbInformation, "Kutools for Excel"
        GoTo LInput
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    xCount = xRg.Rows.Count
    xColor1 = RGB(255, 0, 0) ' Red color
    xColor2 = RGB(0, 0, 255) ' Blue color
    For K = 1 To xRg.Columns.Count
        For I = xCount To 1 Step -1
            xRg.Cells(I, K).Interior.Color = RGB( _
                Int((xCount - (I - 1)) / xCount * (xColor2 Mod 256) + (I - 1) / xCount * (xColor1 Mod 256)), _
                Int((xCount - (I - 1)) / xCount * ((xColor2 \ 256) Mod 256) + (I - 1) / xCount * ((xColor1 \ 256) Mod 256)), _
                Int((xCount - (I - 1)) / xCount * (xColor2 \ 65536) + (I - 1) / xCount * (xColor1 \ 65536)))
        Next
    Next
    Application.ScreenUpdating = True
End Sub


Please have a try, hope them can help you!
This comment was minimized by the moderator on the site
Hallo,

Ich habe zu erst den ersten code verwendet, das funktioniert aber leider nicht. der färbt nur einzelne Zellen und die in komplett anderen Farben. Der Code für dunkel oben nach hell unten funktioniert gar nicht bei mir. Da kommt immer ein Syntax Error. Gibt es noch andere möglichkeiten einen Farbverlauf über mehrere Zellen zu erschaffen oder gibt es da eine andere Lösung für mich?

Vielen lieben Dank vorab schon mal.
This comment was minimized by the moderator on the site
Hello, How can I aply this formula for two colors, above I can't watch de solution. Please
This comment was minimized by the moderator on the site
Hello, Can you apply this to a range like 1 to 5 , cells having a number in them, having the 5 as the darkest ?
Would Kutools be able to do a little similar to above , but then arrange a row of numbers into a scale - not good at explaining. Say a survey answering on a scale of 1 to 5 , then graphical show one bar per question showing percent of answers in 1, 2 ,3 ,4 ,5 ; 5% 1's, 10% 2's 15% 3's and 50% 4's , 20% 5's but showing a gradient of colours in a horizontal bar (better if 2 colours).
Thanks , Gord
This comment was minimized by the moderator on the site
Hi, I've tried copying the VBA code but when I try to run it I keep getting a message that says 'Compile Error: Invalid Outside Procedure'....


How do I fix this??


Thanks!
This comment was minimized by the moderator on the site
Hello, how can I go from yellow to red (for example)? It works only from White to an other color. I work with the code from left to right.
This comment was minimized by the moderator on the site
Hello, Jasmin,
Sorry for that, this code only applied to one color, and if you want to fill gradient from left to tight, the below comment has the solution, please check it.
Thank you!
This comment was minimized by the moderator on the site
Hello, Can you apply this to a range like 1 to 5 , cells having a number in them, having the 5 as the darkest ?

Would Kutools be able to do a little similar to above , but then arrange a row of numbers into a scale - not good at explaining. Say a survey answering on a scale of 1 to 5 , then graphical show one bar per question showing percent of answers in 1, 2 ,3 ,4 ,5 ; 5% 1's, 10% 2's 15% 3's and 50% 4's , 20% 5's but showing a gradient of colours in a horizontal bar (better if 2 colours).

Thanks , Gord
This comment was minimized by the moderator on the site
Why I got Black-White color replace my gradient
This comment was minimized by the moderator on the site
Hello! I have the same problem, i choose the colors for my gradient but when applying the code it turns into black to white gradient. Anyy help?? thanks!
This comment was minimized by the moderator on the site
Hello, Piyaphan,
The above code works well in my worksheet, which Excel version do you use?
Or you can give your problem more detailed.
Thank you!
This comment was minimized by the moderator on the site
hey, I'm not that used to VBA codes. How do I set another color in the code?
This comment was minimized by the moderator on the site
Hello, paul,
If you want to set another color, you just need to fill your desired color to the cells, and then apply the above code in this article.
Please try it.
This comment was minimized by the moderator on the site
thanks! it works :)
This comment was minimized by the moderator on the site
How do I get this to have the gradient go left to right?
This comment was minimized by the moderator on the site
Hello, Sean,
To apply the color gradient from left to right, please use the following VBA code:

Sub colorgradientmultiplecells()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xColor As Long
Dim I As Long
Dim K As Long
Dim xCount As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput:
Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Areas.Count > 1 Then
MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"
GoTo LInput
End If
On Error Resume Next
Application.ScreenUpdating = False
xCount = xRg.Columns.Count
For K = 1 To xRg.Rows.Count
xColor = xRg.Cells(K, 1).Interior.Color
For I = xCount To 1 Step -1
xRg.Cells(K, I).Interior.Color = xColor
xRg.Cells(K, I).Interior.TintAndShade = (xCount - (I - 1)) / xCount
Next
Next
End Sub

Hope it can help you, thank you!
This comment was minimized by the moderator on the site
How can I make the code to go it from right to left, Thanks in advance
This comment was minimized by the moderator on the site
Hello, Ashley,
To make the color gradient from right to left, the following vba code can help you, please try it.

Sub colorgradientmultiplecells()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xColor As Long
Dim I As Long
Dim K As Long
Dim xCount As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput:
Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Areas.Count > 1 Then
MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"
GoTo LInput
End If
On Error Resume Next
Application.ScreenUpdating = False
xCount = xRg.Columns.Count
For K = 1 To xRg.Rows.Count
xColor = xRg.Cells(K, 1).Interior.Color
For I = xCount To 1 Step -1
xRg.Cells(K, I).Interior.Color = xColor
xRg.Cells(K, I).Interior.TintAndShade = I / xCount
Next
Next
End Sub
This comment was minimized by the moderator on the site
Is it possible to perform this gradient but from bottom left to top right?
This comment was minimized by the moderator on the site
Is it possible to post a code that does gradient from top to bottom? I would really appreciate it.
This comment was minimized by the moderator on the site
I would need the code from the darkest shade at the top to the lighter shade at the bottom as well.. :(
This comment was minimized by the moderator on the site
Hi, Laura,
To sove your task, please apply the folloiwng code:

Sub colorgradientmultiplecells()

'Updateby Extendoffcie

Dim xRg As Range

Dim xTxt As String

Dim xCell As Range

Dim xColor As Long

Dim I As Long

Dim K As Long

Dim xCount As Long

On Error Resume Next

If ActiveWindow.RangeSelection.Count > 1 Then

xTxt = ActiveWindow.RangeSelection.AddressLocal

Else

xTxt = ActiveSheet.UsedRange.AddressLocal

End If

LInput:

Set xRg = Application.InputBox("please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)

If xRg Is Nothing Then Exit Sub

If xRg.Areas.Count > 1 Then

MsgBox "does not support multiple selections", vbInformation, "Kutools for Excel"

GoTo LInput

End If

On Error Resume Next

Application.ScreenUpdating = False

xCount = xRg.Rows.Count

For K = 1 To xRg.Columns.Count

xColor = xRg.Cells(1, K).Interior.Color

For I = xCount To 1 Step -1

xRg.Cells(I, K).Interior.Color = xColor

xRg.Cells(I, K).Interior.TintAndShade = I / xCount

Next

Next

End Sub

Please try, hope it can help you!
This comment was minimized by the moderator on the site
How would I do this if I wanted it top left to bottom right gradient?
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations