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

[mostafap4]

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

[m_d6712]

با سلام!
برای این کار کد زیر را در 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]

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

[mostafap4]

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

[khakzad]

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

[m_d6712]

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


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




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.Transparen cy = 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





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

[khakzad]

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

[mostafap4]

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

[ariyo]

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

[ariyo]

با عرض سلام مجدد
برای اینکه امکان رسم دایره بصورت دلخواه باشه. من کدی آماده کرده ام که شما می توانید با استفاده از اون یک منوی 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]

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


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

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





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


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

[ariyo]

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

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