اريد طريقة اضافة border للخلايا التي تحتوي على بيانات فقط

[اشرف النعاس]

اريد طريقة اضافة border للخلايا التي تحتوي على بيانات فقط عن طريق vba 

[عبدالسلام ابوالعوافي]

Sub BorderCells()
    Dim rng As Range
    Selection.Borders(xlEdgeLeft).LineStyle = 0
    Selection.Borders(xlEdgeTop).LineStyle = 0
    Selection.Borders(xlEdgeBottom).LineStyle = 0
    Selection.Borders(xlEdgeRight).LineStyle = 0
    Selection.Borders(xlInsideVertical).LineStyle = 0
    Selection.Borders(xlInsideHorizontal).LineStyle = 0
    For Each rng In Selection
        If Len(rng) <> 0 Then
            rng.Borders(xlEdgeLeft).LineStyle = 1
            rng.Borders(xlEdgeTop).LineStyle = 1
            rng.Borders(xlEdgeBottom).LineStyle = 1
            rng.Borders(xlEdgeRight).LineStyle = 1
        End If
    Next
End Sub

الكود يطبق علي الخلايا المحددة .. يمكن استبدال السليكشن بالنطاق المراد تطبيق الكود عليه

[سليم حاصبيا]

بعد اذن اخي عبد السلام

كود مختصر

Sub show_borders()
    With Selection.Borders
        .LineStyle = xlNone
        .LineStyle = xlContinuous
    End With
    
     With Selection.SpecialCells(xlCellTypeConstants, 23).Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
    End With
    
End Sub

 

[اشرف النعاس]

كيف استخدم هذا الكود لنطاق معيد على سبيل المتال من A2 الى D10  في sheet 1

[سليم حاصبيا]

19 دقائق مضت, اشرف النعاس said:

كيف استخدم هذا الكود لنطاق معيد على سبيل المتال من A2 الى D10  في sheet 1

استبدل كلمة selection  باسم النطاق ليصبح الكود هكذا

Sub show_borders()
    With sheets("sheet1").Range("a2:d10").Borders
        .LineStyle = xlNone
        .LineStyle = xlContinuous
    End With
    
     With sheets("sheet1").Range("a2:d10").SpecialCells(xlCellTypeConstants, 23).Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
    End With
    
End Sub

 

تم تعديل يونيو 26, 2016 بواسطه سليم حاصبيا

[اشرف النعاس]

للاسف لم يشتغل الكود اخي سليم 

[سليم حاصبيا]

59 دقائق مضت, سليم حاصبيا said:

 

 

12 دقائق مضت, اشرف النعاس said:

للاسف لم يشتغل الكود اخي سليم 

جرب المرفق

 

Bord.rar

[اشرف النعاس]

اخي سليم هندما تكون كل الخلايا فارغة يعطي خطا

تم تعديل يونيو 26, 2016 بواسطه اشرف النعاس

[أبو حنــــين]

احسن و اسهل طريقة هي بالتنسيق الشرطي

[سليم حاصبيا]

اضف هذا السطر البسيط الى الكود مباشرة بعد السطر الاول (ليصبح هو الثاني)

On Error Resume Next

 

[عبدالسلام ابوالعوافي]

بعد اذن اخي سليم .. كود مختصر اكثر

Sub BorderCells()
    Selection.Borders.LineStyle = 0
    If Application.WorksheetFunction.CountA(Selection) = 0 Then Exit Sub
    Selection.SpecialCells(2, 23).Borders.LineStyle = 1
End Sub