تغییر رنگ سطر و ستون با حرکت نشانگر موس

**amir_ts** · 2016/09/27, 15:31

با سلام
کد زیر را امتحان کنید.
با انتخاب سلول ردیف و ستون سلول مورد نظر رنگی میشود.

کد:

[LEFT]

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim prow, pcolumn As Integer
Static xrow
Static xcolumn
If xcolumn <> "" Then
    With Columns(xcolumn).Interior
        .ColorIndex = xlNone
    End With
    With Rows(xrow).Interior
        .ColorIndex = xlNone
    End With
End If
prow = Selection.Row
pcolumn = Selection.Column
xrow = prow
xcolumn = pcolumn
With Columns(pcolumn).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
With Rows(prow).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
End Sub

[/LEFT]

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

test_01.rar (13.4 کیلو بایت, مشاهدات 95)

**rjfri** · 2016/09/28, 10:59

با سپاس از شما
چنانچه بخواهیم این اتفاق در تمام شیتها بیوفته به چه صورت باید عمل کرد؟

**amir_ts** · 2016/09/28, 11:27

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

با سپاس از شما
چنانچه بخواهیم این اتفاق در تمام شیتها بیوفته به چه صورت باید عمل کرد؟

با سلام
کد رو در تمام شیت ها کپی کنید.

**Ali Parsaei** · 2016/09/28, 11:28

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

با سلام
با چه فرمولی تو conditional formatting میشه تعریف کرد که با حرکت نشانگر موس روی صفحه رنگ سطر و ستون مربوطه تغییر کنه؟

سلام،
conditional formatting را نمي توان به حرکت موس يا حتي به انتخاب يا عدم انتخاب يک سل ربط داد و اين کار غير ممکن است.
فقط با کد نويسي همانطور که دوستمان آقا امير گفتند يک کارهايي مي شود کرد که البته چون کد آن تو رويداد SELECTION CHANGE نوشته مي شود فايل را کند خواهد کرد.

**MORTEZA9595** · 2016/09/30, 04:30

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

با سلام
کد زیر را امتحان کنید.
با انتخاب سلول ردیف و ستون سلول مورد نظر رنگی میشود.

کد:

[LEFT]

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim prow, pcolumn As Integer
Static xrow
Static xcolumn
If xcolumn <> "" Then
    With Columns(xcolumn).Interior
        .ColorIndex = xlNone
    End With
    With Rows(xrow).Interior
        .ColorIndex = xlNone
    End With
End If
prow = Selection.Row
pcolumn = Selection.Column
xrow = prow
xcolumn = pcolumn
With Columns(pcolumn).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
With Rows(prow).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
End Sub

[/LEFT]

با سلام
این کد رو که وارد می کنیم کار می کنه ولی بعد از بستن و دو باره باز کردن فرمول از کار افتاده و کار نمیکنه

**amir_ts** · 2016/09/30, 09:08

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

با سلام
این کد رو که وارد می کنیم کار می کنه ولی بعد از بستن و دو باره باز کردن فرمول از کار افتاده و کار نمیکنه

با سلام
از ذخیره کردن کدها در فایل مربوطه مطمئن هستید.
فایل نمونه رو هم امتحان کردید؟؟!!

**iranweld** · 2016/09/30, 10:00

فایل پیوست را بررسی نمایید

کد PHP:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rowNumberValue As Integer, columnNumberValue As Integer, i As Integer, j As Integer

Cells.Interior.ColorIndex = 0

rowNumberValue = ActiveCell.Row

columnNumberValue = ActiveCell.Column

    For i = 1 To columnNumberValue
    
    Cells(rowNumberValue, i).Interior.ColorIndex = 37
    
    Next
    
   For j = 1 To rowNumberValue
    
     Cells(j, columnNumberValue).Interior.ColorIndex = 37
     
     Next
     
     Cells(rowNumberValue, columnNumberValue).Interior.ColorIndex = 4


End Sub

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

رنگی شدن سلول اک&#.xls (39.0 کیلو بایت, مشاهدات 49)

**برنا جوان** · 2017/03/16, 12:42

سلام و عرض ادب خدمت کلیه اساتید گرامی
اخرین کد ارائه شده توسط دوستان

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rowNumberValue As Integer, columnNumberValue As Integer, i As Integer, j As Integer

Cells.Interior.ColorIndex = 0

rowNumberValue = ActiveCell.Row

columnNumberValue = ActiveCell.Column

For i = 1 To columnNumberValue

Cells(rowNumberValue, i).Interior.ColorIndex = 37

Next

For j = 1 To rowNumberValue

Cells(j, columnNumberValue).Interior.ColorIndex = 37

Next

Cells(rowNumberValue, columnNumberValue).Interior.ColorIndex = 4

End Sub

بسیار عالی است و بنده به نوبه خودم بسیار سپاسگزارم. تنها ضعف کد و شاید هم بنده (نکته یا ریزه کاری دارد که بنده بلد نیستم و رعایت نمیکنم) این است که پس از بسته و باز نمودن فایل، فرمول کارآیی نداشته و موضوع رنگی شدن خودکار سطر و ستون منتفی میگردد.

لطفا در صورت امکان راهنمائی بفرمائید.
لازم بذکر است که فایل های پیوست را هم دانلود و امتحان نمودم، همین مشکل را دارند.

با سپاس فراوان

**iranweld** · 2017/03/16, 17:41

با سلام
شما بایستی فایل جدید را بصورت macroenable یا اکسل ۲۰۰۷ ذخیره کنید

**برنا جوان** · 2017/03/18, 10:54

سلام و عرض ادب
همین کار رو انجام دادم ولی بازهم مشکل دارد.

**majid_mx4** · 2017/03/18, 15:26

با سلام و صد البته تبریک سال نو و آرزوی سلامتی و کامیابی برای یکایک اعضای انجمن اکسل ایران و مدیران زحمت کش آن.

در پاسخ شما به اینکه چگونه در تمامی شیت ها این اتفاق بیافته فقط کافیست به محیط ماکرو رفته و روی Thisworkbook کلیک کنید و کد زیر را که زحمت آن را جناب آقای iranweld عزیز کشیدن رو اضافه کنید .

کد:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim rowNumberValue As Integer, columnNumberValue As Integer, i As Integer, j As Integer
 Cells.Interior.ColorIndex = 0
 rowNumberValue = ActiveCell.Row
 columnNumberValue = ActiveCell.Column
For i = 1 To columnNumberValue
 Cells(rowNumberValue, i).Interior.ColorIndex = 37
 Next
For j = 1 To rowNumberValue
 Cells(j, columnNumberValue).Interior.ColorIndex = 37
 Next
 Cells(rowNumberValue, columnNumberValue).Interior.ColorIndex = 4
End Sub

و آن را با پسوند Xlsm ذخیره کنید

پایدارو پیروز باشید میر