پرسش خطا در اجرای کد

[میثم مقدم نیا]

سلام
میخواهم برای تغیر رنگShapes ها در داخل اکسل از کد

Sub ChangeShapeColor()

Dim sh_name As String, w As Worksheet, sp As Shape
With Application
    .ScreenUpdating = 0
    Set w = Worksheets("Sheet1")
    sh_name = w.Shapes(Application.Caller).Name
    For Each sp In w.Shapes
    w.Shapes.Range(sp.Name).Select
        If sp.Name <> sh_name Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 192, 0)
        Else:
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
        End If
        
    Next sp
    [b3].Select
    .ScreenUpdating = -1
    
End With

End Sub 

استفاده کنم ولی پیغام خطای میده
اساتید میتونید راهنمای کنید
اکسل من 2019 هستش

[karimi6155]

سلام
با این تغییرات امتحان کنید ببینید جواب میده؟

Sub ChangeShapeColor()

Dim sh_name As String, w As Worksheet, sp As Shape
With Application
    .ScreenUpdating = 0
    Set w = Worksheets("Sheet1")
    sh_name = ActiveSheet.Shapes(Application.Caller).Name
    w.Activate
    For Each sp In w.Shapes
    w.Shapes.Range(sp.Name).Select
        If sp.Name <> sh_name Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 192, 0)
        Else:
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
        End If
        
    Next sp
    [b3].Select
    .ScreenUpdating = -1
    
End With

End Sub 

[میثم مقدم نیا]

سلام
با این تغییرات امتحان کنید ببینید جواب میده؟

Sub ChangeShapeColor()

Dim sh_name As String, w As Worksheet, sp As Shape
With Application
.ScreenUpdating = 0
Set w = Worksheets("Sheet1")
sh_name = ActiveSheet.Shapes(Application.Caller).Name
w.Activate
For Each sp In w.Shapes
w.Shapes.Range(sp.Name).Select
If sp.Name <> sh_name Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 192, 0)
Else:
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
End If

Next sp
[b3].Select
.ScreenUpdating = -1

End With

End Sub 

سلام ممنون
از راهنمایتون
مشکل اصلی تو خط

    Set w = Worksheets("Sheet1")

است که بجای شیت فعال شیت اول انتخاب شوده

[Alireza_Mind]

سلام دوست عزیز، منظورتون دقیق متوجه نشدم ولی فکر کنم با این مشکلتون حل بشه.

Sub ChangeShapeColor()

    Dim sh_name As String, sp As Shape
    With Application
        .ScreenUpdating = 0
        sh_name = ActiveSheet.Shapes(Application.Caller).Name
        For Each sp In ActiveSheet.Shapes
            If sp.Name <> sh_name Then
                sp.Fill.ForeColor.RGB = RGB(255, 192, 0)
            Else
                sp.Fill.ForeColor.RGB = RGB(0, 255, 0)
            End If
        Next sp
        .ScreenUpdating = -1
    End With

End Sub