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

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • ali719

    • 2013/12/05
    • 200

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

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

    • 2010/11/11
    • 362

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

    کد:
    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

      • 2013/09/20
      • 4522
      • 100.00

      #3
      نوشته اصلی توسط MEYTI
      با سلام دوست عزیز کد زیر خدمت شما
      ممنون مهدي جان ولي رو سيستم من جواب نميده. ميشه فايلشو بذاري؟

      کامنت

      • MEYTI

        • 2010/11/11
        • 362

        #4
        خدمت شما
        فایل های پیوست شده
        مهدی کریمی

        کامنت

        • Amir Ghasemiyan

          • 2013/09/20
          • 4522
          • 100.00

          #5
          نوشته اصلی توسط MEYTI
          خدمت شما
          ممنون مهدي جان ولي كار نميكنه كه
          منم يه كد شبيه اين پيدا كرده بودم ولي اونم كار نميكرد. بقيه دوستان لطف كنن چك كنن ببينم مشكل از سيستم منه يا كد

          کامنت

          • MEYTI

            • 2010/11/11
            • 362

            #6
            امیر جان مشکلت کجاست؟ ارور میده؟
            Last edited by MEYTI; 2014/01/16, 17:44.
            مهدی کریمی

            کامنت

            • Amir Ghasemiyan

              • 2013/09/20
              • 4522
              • 100.00

              #7
              نوشته اصلی توسط MEYTI
              امیر جان مشکلت کجاست؟ ارور میده؟
              نه عزيز مشكل اينجاس كه هيچ اتفاق خاصي نميفته.

              کامنت

              • MEYTI

                • 2010/11/11
                • 362

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

                کامنت

                • Amir Ghasemiyan

                  • 2013/09/20
                  • 4522
                  • 100.00

                  #9
                  نوشته اصلی توسط MEYTI
                  دروباره چک کن در ستون a هر مقداری بنویسی سطر جلوشو باید خط دار کنه
                  دوستان دیگه هم چک کنن
                  نميدونم مشكل چي بود. سيستم رو ري استارت كردم درست شد
                  ممنون مهدي جان

                  کامنت

                  • Amir Ghasemiyan

                    • 2013/09/20
                    • 4522
                    • 100.00

                    #10
                    نوشته اصلی توسط 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

                    کامنت

                    • ali719

                      • 2013/12/05
                      • 200

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

                      کامنت

                      چند لحظه..