کشیده شدن دایره قرمز دور سلول

[mostafap4]

با سلام
میخواستم ببینم میشه با ماکرو نویسی کدی نوشت که اگر سلولی شرط if ما را رعایت نکرده بود دور آن دایره ای مثلا قرمز رنگ ترسیم شود؟
ممنون میشم راهنمایی کنید

[m_d6712]

RE: کشیده شدن دایره قرمز دور سلول

با سلام!
برای این کار کد زیر را در Codeview شیت مورد نظر کپی کنید. شرطی که من در نظر گرفتم بزرگتر بودن عدد از 10 می باشد. یعنی هر عددی بزرگتر از 10 در هر سلولی وارد کردید دور آن سلول یک دایره رسم می کند.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value > 10 Then
Sheet1.Shapes.AddShape msoShapeOval, Target.Left - 5, Target.Top - 5, Target.Width + 10, Target.Height + 10
Sheet1.Shapes(Sheet1.Shapes.Count).Fill.Transparen cy = 1
Sheet1.Shapes(Sheet1.Shapes.Count).Line.ForeColor. RGB = 255
End If
End Sub


برای کمک فایل رو هم آپلود کردم: http://www.mediafire.com/file/010lmnlnda1lkm8/ovalAroundCell.xlsm

[khakzad]

RE: کشیده شدن دایره قرمز دور سلول

با تشکر از دوست عزیز آقای داوری
کد خیلی قشنگیه.
اما خوب، این در صورت تغییر دادن یک سلول به مقدار قابل قبول برای شرط، دایره سر جاش می مونه! که البته قطعا راه حلی براش دارید.
اما می تونیم از data validataion هم استفاده کنیم.اینطوری شرط رو هم به راحتی تغییر میدیم. و هر بار با زدن کلید circle invalid data اطلاعات خارج از رنج رو مشخص می کنه
[hr]
و البته شیت ما تعداد shape ها زیاد نمیشه!!!
موفق باشید

[mostafap4]

RE: کشیده شدن دایره قرمز دور سلول

سلام
ممنونم
خدمت دوست خوبم آقای خاکزاد عرض کنم که با دیتا ولیدیشن نمیشه شرط مانند if گذاشت ولی با این کدی که آقای داوری فرمودند بنظرم میشه و هنوز امتحان نکردم ولی میش به احتمال زیاد
ممنونم دوستان

[khakzad]

RE: کشیده شدن دایره قرمز دور سلول

البته.منم برای حالت های ساده گفتم.یه جورایی تبدیل if به عبارت های ساده.اما در کل کد آقای داوری جامع تر هست
موفق باشید.

[m_d6712]

RE: کشیده شدن دایره قرمز دور سلول

سلام!
البته این روش یک مقدار غیر استاندارد هم هست! شما اگر بخواهید می توانید به راحتی از Property های خود سلول استفاده نمایید. یعنی Border و forecolor یا Interior یا هر Property دیگر که جهت تمیز دادن بشه به آن اتکا کرد. اما هیچ راهی برای ایجاد Oval یا بیضی و دایره با استفاده از Property سلول وجود ندارد. که برای این کار مجبور هستیم از Shape استفاده نماییم.
در صورتی که شکل اهمیت خاصی ندارد و فقط تمیز دادن برای شما مهم است بهتر است از روش Property سلول استفاده نمایید.


اما در مورد دایره و در مورد سوال خانم خاکزاد:
منتظر این سوالتون بودم. این هم راحل داره! این کد رو جایگزین کد قبل کنید:

[align=left]

Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Target.Text) Then
   If Target.Value > 10 Then
        Sheet1.Shapes.AddShape msoShapeOval, Target.Left - 5, Target.Top - 5, Target.Width + 10, Target.Height + 10
        Sheet1.Shapes(Sheet1.Shapes.Count).Fill.Transparency = 1
        Sheet1.Shapes(Sheet1.Shapes.Count).Line.ForeColor.RGB = 255
    Else
        For Each Shape In Sheet1.Shapes
            If Shape.Left = Target.Left - 5 And Shape.Top = Target.Top - 5 Then
                Shape.Delete
                Exit For
            End If
        Next
    End If
Else
    For Each Shape In Sheet1.Shapes
        If Shape.Left = Target.Left - 5 And Shape.Top = Target.Top - 5 Then
             Shape.Delete
           Exit For
        End If
    Next
End If
End Sub

[/align]

درست همون چیزی که انتظار دارید اتفاق می افته!

[khakzad]

RE: کشیده شدن دایره قرمز دور سلول

خیلی جالب بود.
ممنون.

[mostafap4]

RE: کشیده شدن دایره قرمز دور سلول

با سلام
یک سوال چه کدی قبلش اضافه کنیم که قبل از اینکه شروع به چک کردن شرط کنه همه ی داده ها را از وجود بیضی پاک کنه و سپس مجددا شروع به کشیدن بیضی کنه؟

[ariyo]

RE: کشیده شدن دایره قرمز دور سلول

با سلام به همه ی دوستان
همانطور که همه میدونید این کار زیاد استاندارد نیست چون بسته به نوع کار و اندازه ها و تعداد اعداد زیاد مطلوب به نظر نمی رسه. به نظر بنده اگر از Validation تنها استفاده بشه خیلی بهتره. یا اینکه از Validation در قالب کد استفاده بشه.
اما اگر الزام به دایره کشیدن باشه، میشه تحت یک ماکرو که بوسیله کاربر فراخوانی بشه و حتی پارامترهای رسم را هم بشوه وارد کرد در نظر گرفت. فکر می کنم به این شکل زیباتر بشه و کار از شلوغی در بیاد.
اما از m_d6712 و khakzad به دلیل توجه و پیگیریشون کمال تشکر رو دارم.

[ariyo]

RE: کشیده شدن دایره قرمز دور سلول

با عرض سلام مجدد
برای اینکه امکان رسم دایره بصورت دلخواه باشه. من کدی آماده کرده ام که شما می توانید با استفاده از اون یک منوی Right-Click داشته باشید و روی هر سلول که کلیک راست کنید و گزینه Draw Shape رو انتخاب کنید، یک بیضی قرمز رنگ روی همان سلول رسم کنه.
کد از دو قسمت تشکیل شده.
1- ابتدا کد زیر زا در قسمت کد ThisWorkbook قرار دهید.

Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.CommandBars("Cell").Controls("My Macro").Delete
End With
On Error GoTo 0
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cBut As CommandBarButton
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Draw Shape").Delete
Set cBut = .CommandBars("Cell").Controls.Add(Temporary:=True)
End With
With cBut
.Caption = "Draw Shape"
.Style = msoButtonCaption
.OnAction = "draw_shape"
End With
On Error GoTo 0
End Sub

2- حالا یک ماژول به پروژه اضافه نموده و سپس کد زیر را در داخل آن کپی نمایید.

Sub draw_shape()
Dim intleft As Integer, inttop As Integer, intwidth As Integer, intheight As Integer

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

intleft = Selection.Left - 5
inttop = Selection.Top - 5
intwidth = Selection.Width + 10
intheight = Selection.Height + 10

With ActiveSheet.Shapes
.AddShape msoShapeOval, intleft, inttop, intwidth, intheight
End With
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Fill. Transparency = 1
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Line. ForeColor.RGB = 255
End Sub


حالا شما در داخل پروژه اگر روی سلول کلیک راست نمایید (در هر شیت که مایلید)، گزینه ی Draw Shape را خواهید دید و با انتخاب آن می توانید روی همان سلول یک دایره(بیضی) قرمز رنگ رسم نمایید.

فایل نمونه برای دانلود
http://www.4shared.com/file/csiM-94z/draw_oval.html

شاد و سلامت باشید

[m_d6712]

RE: کشیده شدن دایره قرمز دور سلول

با سلام به همه ی دوستان
همانطور که همه میدونید این کار زیاد استاندارد نیست چون بسته به نوع کار و اندازه ها و تعداد اعداد زیاد مطلوب به نظر نمی رسه. به نظر بنده اگر از Validation تنها استفاده بشه خیلی بهتره. یا اینکه از Validation در قالب کد استفاده بشه.

با تشکر از کد خوب شما
این که استاندارد نیست رو کاملا موافقم.
این که استفاده از validation ها نیز خیلی راحت و کاربردیه نیز موافقم.
اما به نظر من validation محدودیت داره! بعضی وقتا نیاز هست که از این روش استفاده کنیم. برای مثال برای شرط های پیچیده.
استاندارد نبودن در استفاده از Shape است نه استفاده از VBA.
اگر به جای یک دایره از یک Border قرمز دور سلول بهره می گرفتیم خیلی راحت تر بود و حجم پردازشی کمتری داشتیم.

اما ابتدا بیایم دلیل استاندارد نبودن رو بگیم.
دلیل اینه که داریم یک شی خارج از اشیاء منظم و پشت سر هم داخل شیت (سلول ها)، برای یک سلول خاص ایجاد می کنیم. این چند ایراد داره:
1- بعد از این که شی ایجاد میشه برای پیدا کردن شی مشکلاتی داریم. زیرا ارتباط بین شی سلول و شی دایره وجود نداره. فقط هر دو عضوی از شی Datasheet می باشند. این کمی کار رو سخت می کنه! که این راه حل هایی داره. یعنی با برنامه نویسی قابل حل است.
2- از نظر مفهومی: اینکه بخواهیم یک شی رو مشخص کنیم و اون رو یک طوری متمایز کنیم داریم از یک شی خارجی کمک می گیریم که این در شی گرایی عیب محسوب میشه! هر شی باید برای بروز مشخصات خودش از مشخصه های (property) خودش استفاده کند. این به تنهایی مشکلی ایجاد نمی کند. اما در هر شی مشخصات زیادی وجود دارد که در ارتباط با یکدیگر می باشند. در داخل یک شی با تغییر یک مشخصه مشخصات دیگری نیز تغییر می کنند. که این وجه قضیه دردسر ساز می باشد.
برای حل مشلکل دوم هم راه حل کدنویسی وجود داره! افزودن کلاس های کمکی

برای اینکه امکان رسم دایره بصورت دلخواه باشه. من کدی آماده کرده ام که شما می توانید با استفاده از اون یک منوی Right-Click داشته باشید و روی هر سلول که کلیک راست کنید و گزینه Draw Shape رو انتخاب کنید، یک بیضی قرمز رنگ روی همان سلول رسم کنه.

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

[ariyo]

RE: کشیده شدن دایره قرمز دور سلول

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

شاد و سربلند باشید.