اريد كود يقوم بعمل بوردر للخلايا التى بها بيانات فى نطاق محدد

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

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

اريد كود يقوم بعمل بورد للخلايا التى

بها بيانات فقط  فى نطاق محدد

border.rar

تم تعديل فبراير 27, 2013 بواسطه إبراهيم ابوليله

[رجب جاويش]

أخى ابراهيم

جرب الكود التالى

فى حدث الصفحة

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each cl In Intersect(Target, Range("D:D")).Cells
If cl = "" Then
Target.Borders.LineStyle = xlNone
Else
Target.Borders.ColorIndex = 1
End If
Next
End If
End Sub

وهو يمعل عند وضع بيانات فى العمود D  ويمكنك تغيرة كما تريد

 

[رجب جاويش]

أخى ابراهيم

جرب الكود التالى

فى حدث الصفحة

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each cl In Intersect(Target, Range("D:D")).Cells
If cl = "" Then
Target.Borders.LineStyle = xlNone
Else
Target.Borders.ColorIndex = 1
End If
Next
End If
End Sub

وهو يعمل عند وضع بيانات فى العمود D  ويمكنك تغيره كما تريد

 

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

اخى الكريم رجب

بارك الله فيك

ولكن ماذا سيكون شكل الكود بدون زر

وماذا لو اردت استخدام 

الشكل الاتى

 

If Range("d5:d" & LR) <> "" Then

Range("d5:d" & LR).HorizontalAlignment = xlCenter

Range("d5:d" & LR).VerticalAlignment = xlCenter

Range("d5:d" & LR).Font.Size = 16

Range("d5:d" & LR).Font.Name = "Agency FB"

Range("d5:d" & LR).Font.Size = 16

Range("d5:d" & LR).Borders.LineStyle = xlContinuous

Else

Range("d5:d" & LR).ClearFormats

END SUB

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

للرفع

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

للرفع

[عبدالله باقشير]

السلام عليكم

 

في الملف حلين

بزر وبالتغيير التلقائي في النطاق "C3:G8"

 

هذا عند التغيير في النطاق

 

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:G8")) Is Nothing Then
    If IsEmpty(Target) Then
        Target.ClearFormats
    Else
        kh_Formats Target
    End If
End If
End Sub

 

واذا اردته بزر هذا الكود

يرتبط بالزر

 

'

 

  هذا الكود بربوط بالزر
Sub kh_SetRng()
Dim Rng As Range, cel As Range
Range("C3:G8").ClearFormats
For Each cel In Range("C3:G8")
    If Not IsEmpty(cel) Then
        If Rng Is Nothing Then Set Rng = cel Else Set Rng = Union(Rng, cel)
    End If
Next
kh_Formats Rng
Set Rng = Nothing
End Sub


 

وهذا الكود ذو الوسيط

بستخدم من الكودين لتغيير الفورمات

 

Sub kh_Formats(RngFormat As Range)
If Not RngFormat Is Nothing Then
With RngFormat
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Name = "Agency FB"
    .Font.Size = 16
    .Borders.LineStyle = xlContinuous
End With
End If

End Sub
 

شاهد المرفق 2010

 

border.rar

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

اخى الكريم

عبد الله

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

بارك الله فيك