ایجاد border در اکسل

[ali719]

سلام
من باید چکار کنم تا وقتی در ستون A عددی وارد می کنم سلولهای B تا F حالت Border بگیرند
با تشکر

[MEYTI]

با سلام دوست عزیز کد زیر خدمت شما

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Column = 1 Then
m = Target.Row

Range(Cells(m, "B"), Cells(m, "f")).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With


End If

End Sub

[Amir Ghasemiyan]

با سلام دوست عزیز کد زیر خدمت شما

ممنون مهدي جان ولي رو سيستم من جواب نميده. ميشه فايلشو بذاري؟

[MEYTI]

خدمت شما

[Amir Ghasemiyan]

خدمت شما

ممنون مهدي جان ولي كار نميكنه كه
منم يه كد شبيه اين پيدا كرده بودم ولي اونم كار نميكرد. بقيه دوستان لطف كنن چك كنن ببينم مشكل از سيستم منه يا كد

[MEYTI]

امیر جان مشکلت کجاست؟ ارور میده؟

[Amir Ghasemiyan]

امیر جان مشکلت کجاست؟ ارور میده؟

نه عزيز مشكل اينجاس كه هيچ اتفاق خاصي نميفته.

[MEYTI]

دروباره چک کن در ستون a هر مقداری بنویسی سطر جلوشو باید خط دار کنه
دوستان دیگه هم چک کنن

[Amir Ghasemiyan]

دروباره چک کن در ستون a هر مقداری بنویسی سطر جلوشو باید خط دار کنه
دوستان دیگه هم چک کنن

نميدونم مشكل چي بود. سيستم رو ري استارت كردم درست شد
ممنون مهدي جان

[Amir Ghasemiyan]

خدمت شما

مهدي جان زحمت كشيدن و اصل كار رو انجام دادن. منم يه دستكاري كوچولو (البته با اجازه مهدي عزيز) تو فايل كردم وقتي سلول خالي باشه كادر هم جلوش نباشه. شايد كاربرد داشته باشه براتون

اين كدي كه بايد داخل sheet1 نوشته بشه

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Column = 1 Then
m = Target.Row

Range(Cells(m, "B"), Cells(m, "f")).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End If
Range("A" & m).Select
If Target.Value = "" Then Call unboarder(m)

End Sub

اين هم كدي كه داخل يك ماژول نوشته ميشه

Sub unboarder(m)
    Range(Cells(m, "B"), Cells(m, "f")).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A" & m).Select
End Sub

[ali719]

ممنون مهدی جان خیلی عالی بود