صفحه 1 از 2 12 آخرینآخرین
نمایش نتایج: از شماره 1 تا 10 , از مجموع 12

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

  1. #1


    آخرین بازدید
    2022/06/27
    تاریخ عضویت
    July 2010
    نوشته ها
    192
    امتیاز
    295
    سپاس
    107
    سپاس شده
    284 در 99 پست
    سطح اکسل
    75.00 %

    mostafap4 به Yahoo ارسال پیام

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

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

  2.  

  3. #2


    آخرین بازدید
    2022/06/28
    تاریخ عضویت
    May 2010
    محل سکونت
    بلژیک
    نوشته ها
    174
    امتیاز
    108
    سپاس
    0
    سپاس شده
    119 در 53 پست
    تعیین سطح نشده است

    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

  4. #3


    آخرین بازدید
    2023/08/14
    تاریخ عضویت
    March 2010
    محل سکونت
    تهران
    نوشته ها
    2,034
    امتیاز
    4508
    سپاس
    2,467
    سپاس شده
    4,096 در 1,241 پست
    سطح اکسل
    85.00 %

    khakzad به Yahoo ارسال پیام

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

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

  5. #4


    آخرین بازدید
    2022/06/27
    تاریخ عضویت
    July 2010
    نوشته ها
    192
    امتیاز
    295
    سپاس
    107
    سپاس شده
    284 در 99 پست
    سطح اکسل
    75.00 %

    mostafap4 به Yahoo ارسال پیام

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

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

  6. سپاس ها (1)


  7. #5


    آخرین بازدید
    2023/08/14
    تاریخ عضویت
    March 2010
    محل سکونت
    تهران
    نوشته ها
    2,034
    امتیاز
    4508
    سپاس
    2,467
    سپاس شده
    4,096 در 1,241 پست
    سطح اکسل
    85.00 %

    khakzad به Yahoo ارسال پیام

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

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

  8. #6


    آخرین بازدید
    2022/06/28
    تاریخ عضویت
    May 2010
    محل سکونت
    بلژیک
    نوشته ها
    174
    امتیاز
    108
    سپاس
    0
    سپاس شده
    119 در 53 پست
    تعیین سطح نشده است

    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]

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

  9. سپاس ها (1)


  10. #7


    آخرین بازدید
    2023/08/14
    تاریخ عضویت
    March 2010
    محل سکونت
    تهران
    نوشته ها
    2,034
    امتیاز
    4508
    سپاس
    2,467
    سپاس شده
    4,096 در 1,241 پست
    سطح اکسل
    85.00 %

    khakzad به Yahoo ارسال پیام

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

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

  11. #8


    آخرین بازدید
    2022/06/27
    تاریخ عضویت
    July 2010
    نوشته ها
    192
    امتیاز
    295
    سپاس
    107
    سپاس شده
    284 در 99 پست
    سطح اکسل
    75.00 %

    mostafap4 به Yahoo ارسال پیام

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

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

  12. #9


    آخرین بازدید
    2012/08/25
    تاریخ عضویت
    September 2010
    نوشته ها
    35
    امتیاز
    5
    سپاس
    0
    سپاس شده
    3 در 3 پست
    تعیین سطح نشده است

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

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

  13. #10


    آخرین بازدید
    2012/08/25
    تاریخ عضویت
    September 2010
    نوشته ها
    35
    امتیاز
    5
    سپاس
    0
    سپاس شده
    3 در 3 پست
    تعیین سطح نشده است

    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

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

  14. سپاس ها (1)



صفحه 1 از 2 12 آخرینآخرین

اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

https:forum.exceliran.comshowthread.php269-کشیده-شدن-دایره-قرمز-دور-سلول

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است
با ما در تماس باشيد