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

[ali719]

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

[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

[Amir Ghasemiyan]

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

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

[MEYTI]

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

[Amir Ghasemiyan]

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

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

[MEYTI]

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

[Amir Ghasemiyan]

خدمت شما

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

[MEYTI]

خدمت شما

[Amir Ghasemiyan]

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

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

[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

[ali719]

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