كود جاهز_لعمل اطار(سطر تحديد) مع اخر سطر به بيانات

[جلال الجمال_ابو أدهم]

تم رفع هذا الكود فى مشاركة منفصله

حتى لا ننسى هذه المشاركة   كود لتعديل الإطار

 

 

تم ارفاق كود الحل من الفاضل _ أ /  أبوعبد الله

 

 

لاحظ بالملف المرفق بمجرد ادخال بيانات فى العمود _G _ التاريخ يتم تحرك سطر التحديد

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
If Intersect(Target, Range("G3:G1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("G3:G1000")) Is Nothing And Target.Value <> "" And Target.Offset(1, 0).Value = "" Then
    Range(Target, Target.Offset(0, -6)).Select

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlHairline
    End With
Target.Offset(1, -6).Select

Else
    Range(Target, Target.Offset(0, -6)).Select

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = -8355712
        .TintAndShade = 0
        .Weight = xlHairline
    End With
Target.Select
End If
Application.ScreenUpdating = True
End Sub

 و لا تنسونا من صالح الدعاء

 

Format Cells - Border-1.rar

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

أخي الكريم جلال

مع كل احترامي للأخ العزيز أبو عبد الله

الكود بهذا الشكل مريع .. لأنه عبارة عن تسجيل ماكرو ..

يمكن اختصار الكود بشكل كبير جداً .. وسأترك الأمر لأي أخ  ليقوم بالمهمة حتى يكون الكود أفضل

تقبل تحياتي

[جلال الجمال_ابو أدهم]

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

اخى الفاضل تحياتى