تغییر رنگ Shape بر اساس Cell value

[a.dal65]

با سلام خدمت اساتید
بنده نقشه یه طبقه رو دارم که توش مغازه هام مشخص شده .
و یه جدول دارم که اطلاعات اون مغازه ها رو توش زدم.(مثل متراژ ، شماره مغازه و ...)
من روی هر مغازه یه Shape دایره شکل ایجاد کردم که با توجه به وضعیت مغازه میخوام رنگ اون دایره عوض بشه.
یعنی مثلا اگه تو جدول مغازه شماره 1 فروخته شد رنگ دایره بشه قرمز . اگه رزور بود بشه آبی و ....
(یعنی با توجه به Cell Value ، رنگ دایره تغییر کنه)
برای این کار از این کد استفاده کردم که چند تا اشکال داره

    Select Case Range("e2").Value
        Case "رزرو شده": ActiveSheet.Shapes("Oval1").Fill.ForeColor.RGB = vbBlue
        Case "فروخته شده": ActiveSheet.Shapes("Oval1").Fill.ForeColor.RGB = vbRed
        Case "آماده فروش": ActiveSheet.Shapes("Oval1").Fill.ForeColor.RGB = vbGreen
        Case "اجاره داده شده": ActiveSheet.Shapes("Oval1").Fill.ForeColor.RGB = vbYellow
    End Select 

اول اینکه وقتی از فیلتر استفاده میکنم رنگ ها همه جابجا میشه
دوم اینکه من حدود 150 تا مغازه دارم اگه بخوام برای هر سلول همین کد رو تکرار کنم خیلی زمانبر و چر خطا میشه.
امکانش هست از یه حلقه استفاده کنم تا کد ها کمتر بشه ؟

و یه سوال دیگه دارم
من برای فیلتر کردن جدولم از چند تا چک باکس استفاده کردم . تا کاربر مثلا تیک رزور شده ها و اماده فروش ها رو انتخاب کنه و این دو توی جدول فیلتر بشن و روی نقشه هم همون مغازه ها رنگی بشن . الان فقط یکی رو فیلتر میکنه

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

[misammisam]

سلام برای فیلتر باید همه حالتهارو تعریف کنید مثلا برای قسمت اجاره داده شده اینطوری بنویسید ، بقیه قسمتها به عهده خودتون

Private Sub ejare_Click()
If (ejare = True And nashode = True And shode = True And rezerv = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÂãÇÏå ÝÑæÔ", "ÑÒÑæ ÔÏå", "ÝÑæÎÊå ÔÏå"), Operator:=xlFilterValues
ElseIf (ejare = True And nashode = True And shode = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÂãÇÏå ÝÑæÔ", "ÝÑæÎÊå ÔÏå"), Operator:=xlFilterValues
ElseIf (ejare = True And shode = True And rezerv = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÑÒÑæ ÔÏå", "ÝÑæÎÊå ÔÏå"), Operator:=xlFilterValues
ElseIf (ejare = True And nashode = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÂãÇÏå ÝÑæÔ"), Operator:=xlFilterValues
ElseIf (ejare = True And shode = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÝÑæÎÊå ÔÏå"), Operator:=xlFilterValues
ElseIf (ejare = True And rezerv = True) Then
ActiveSheet.ListObjects("Table13").Range.AutoFilter Field:=5, Criteria1:=Array("ÇÌÇÑå ÏÇÏå ÔÏå", "ÑÒÑæ ÔÏå"), Operator:=xlFilterValues
ElseIf ejare = True Then
Range("e1").AutoFilter Field:=5, Criteria1:="ÇÌÇÑå ÏÇÏå ÔÏå"
Else
Range("e1").AutoFilter Field:=5
End If
End Sub 

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

[a.dal65]

ممنون دوست عزیز همونجوری که گفتید درست کردم.

برای قسمتی از مشکل اولم یه سرچ زدم و به این رسیدم :

      Dim i As Long
      For i = 1 To ActiveSheet.Shapes.Count
      ActiveSheet.Shapes.Range(Array("Oval " & i)).Visible = Not ActiveSheet.Shapes.Range(Array("Oval " & i)).Visible
      Next i
  [RIGHT][/RIGHT] 

با کد بالا تمام

Shape های که با اسم oval شروع میشه رو مخفی و شو میکنه

حالا هر کاری کردم که چک کنه مثلا shape های که fill color شون قرمز باشه رو hide کنه نتونستم

(یعنی میخوام تمام oval های که رنگشون قرمز هستن رو مخفی کنم)

ActiveSheet.Shapes.Range(Array("Oval " & i)).Visible.Fill.ForeColor.RGB(vbRed) = True

ممنون میشم کسی کمک کنه

[a.dal65]

Public Sub HideRedOvals()

ShowHideShapes "Oval ", RGB(255, 0, 0), msoFalse

End Sub
Private Sub ShowHideShapes(shapeName As String, foreColor As Long, showHide As MsoTriState)

Dim thisShape As Shape

For Each thisShape In ActiveSheet.Shapes
    If StrComp(Left$(thisShape.Name, Len(shapeName)), shapeName, vbTextCompare) = 0 _
    And thisShape.Fill.foreColor = foreColor Then
        thisShape.Visible = showHide
    End If
Next

End Sub