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

**MEYTI** · 2014/01/16, 09:20

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

کد:

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** · 2014/01/16, 09:29

نوشته اصلی توسط MEYTI

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

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

**MEYTI** · 2014/01/16, 13:55

خدمت شما

فایل های پیوست شده

activerow border.xlsm (16.4 کیلو بایت, مشاهدات 24)

**Amir Ghasemiyan** · 2014/01/16, 14:38

نوشته اصلی توسط MEYTI

خدمت شما

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

**MEYTI** · 2014/01/16, 17:40

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

**Amir Ghasemiyan** · 2014/01/16, 17:52

نوشته اصلی توسط MEYTI

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

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

**MEYTI** · 2014/01/16, 18:42

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

**Amir Ghasemiyan** · 2014/01/16, 22:01

نوشته اصلی توسط MEYTI

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

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

**Amir Ghasemiyan** · 2014/01/16, 22:15

نوشته اصلی توسط MEYTI

خدمت شما

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

اين كدي كه بايد داخل 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