ارجو المساعده فى عمل بوردر عن طريق الاكواد

[إبراهيم ابوليله]

الاخوه الكرام

ارجو المساعده

فى عمل بورد للخالايا بناء على خليه معينه

عن طريق الكودborder.rar

[الـعيدروس]

السلام عليكم

جرب هذا الكود في حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 5 Or Target.Row < 10 Then Exit Sub

If Target = "" Then Exit Sub

Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Borders.ColorIndex = 1

End Sub

[ياسر خليل أبو البراء]

الأخ عباد بارك الله فيك أخي الغالي

اسمح لي بإضافة بسيطة جداً .. عند حذف القيمة الموجودة في الخلية (الهدف) يتم إرجاع الأمر كما كان (بدون تسطير)

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 5 Or Target.Row < 10 Then Exit Sub

If Target = "" Then Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Borders.LineStyle = xlNone: Exit Sub

Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Borders.ColorIndex = 1

End Sub

يبقى شيء واحد أريدك التعديل عليه وهو في حالة مسح بيانات أكثر من خلية في النطاق الهدف يظهر خطأ ... أريد التخلص من الخطأ وفي نفس الوقت أن يقوم بتنفيذ العملية (التخلص من التسطير)

[الخالدي]

السلام عليكم ورحمة الله وبركاته

بعد اذن الاخوة الاحباء العيدروس و ياسر خليل

كود عند اضافة ومسح خلية او اكثر

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range(Cells(10, 5), Cells(Rows.Count, 5)), Target) Is Nothing Then

For Each cl In Intersect(Range(Cells(10, 5), Cells(Rows.Count, 5)), Target).Cells

If cl = "" Then

Range(Cells(cl.Row, 1), Cells(cl.Row, 13)).Borders.LineStyle = xlNone

Else

Range(Cells(cl.Row, 1), Cells(cl.Row, 13)).Borders.ColorIndex = 1

End If

Next

End If

End Sub

[الـعيدروس]

السلام عليكم

تفضل اخي ياسر

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 5 Or Target.Row < 10 Then Exit Sub

On Error Resume Next

Dim A_S As Range, A_Ar As Range

Dim A_Cel As Range

Dim I_Rw%, S_A%, In_A%

Set A_S = Selection

    For Each A_Ar In A_S.Areas

	  For I_Rw = 1 To A_Ar.Rows.Count Step 1

	    Set A_Cel = A_Ar.Rows(I_Rw): In_A = A_Cel.Row: S_A = Cells(In_A, 1).Row

	    Range(Cells(S_A, 1), Cells(S_A, 13)).Borders.ColorIndex = xlNone

	    Next

    Next

If Target = "" Then Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Borders.LineStyle = xlNone: Exit Sub

Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Borders.ColorIndex = 1

End Sub

ارجو التجربه

تحياتي

تم تعديل ديسمبر 18, 2012 بواسطه عباد

[الـعيدروس]

السموحه استاذي الخالدي

لم ارى ردك الا بعد المشاركه

ماشاء الله عليك أخي الخالدي

كودك مختصر ورائع

[دغيدى]

الأخــــــوة الأفاضل

برجـــــاء التكرم منكم بوضع مشاركاتكم داخل ملف لأن بعض الزملاء يصعب عليهم وضع الكود

تحياتى

[إبراهيم ابوليله]

الاخوه الافاضل

الف شكر لحضراتكم

واكواد فى قمه الروعه والجمال

وبارك الله فيكم جميعا

[إبراهيم ابوليله]

الاخوه الكرام

ماذا لو اردنا استخدام زر عمل ذلك

تم تعديل ديسمبر 19, 2012 بواسطه إبراهيم ابوليله

[الـعيدروس]

بيكون بالشكل التالي

Public Sub Ali_Bord()

If ActiveCell.Column <> 5 Or ActiveCell.Row < 10 Then Exit Sub

On Error Resume Next

Dim A_S As Range, A_Ar As Range

Dim A_Cel As Range

Dim I_Rw%, S_A%, In_A%

Set A_S = Selection

    For Each A_Ar In A_S.Areas

	  For I_Rw = 1 To A_Ar.Rows.Count Step 1

	    Set A_Cel = A_Ar.Rows(I_Rw)

	    In_A = A_Cel.Row

	    S_A = Cells(In_A, 1).Row

	    Range(Cells(S_A, 1), Cells(S_A, 13)).Borders.ColorIndex = xlNone

	    Next

    Next

If ActiveCell = "" Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 13)).Borders.LineStyle = xlNone: Exit Sub

Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 13)).Borders.ColorIndex = 1

End Sub

[إبراهيم ابوليله]

الاخ عباد

مشكورا على الرد