Şekil boyamada resim obje hatası

[excellkurdu]

Arkadaşlar merhabalar,
Şekil boyama yaparken belirli sayfalara bazen resim eklemem gerekiyor. O zaman da resim obje hatası alıyorum. Sayfadaki resmi silince makro çalışıyor. Sayfadaki resimleri nasıl yok saydırabiliriz?
Şimdiden teşekkür ederim.

Sub ZEHIRLI_BOYA()
Dim v As Worksheet: Set v = Sheets("Veri")
For Each sayfa In Worksheets
        If sayfa.Name = "Veri" Then
            GoTo 20
        End If
        sayfa.Activate
            sayı = sayfa.DrawingObjects.Count
                For sekil = 1 To sayı
                If Right(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "Bağlayıcı" Or _
                Left(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "AutoShape" Then GoTo 10
                    sayfa.Shapes.Range(Array(sekil)).Select
                        metin = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
                            If metin = "" Or _
                                WorksheetFunction.CountIf(v.Range("B6:B" & v.[B65536].End(3).Row), metin) = 0 Then
                                GoTo 10
                            Else
                            Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
                            satır = WorksheetFunction.Match(metin, v.Range("B1:B" & v.[B65536].End(3).Row), 0)
                                If v.Cells(satır, 4) = "sorunlu" Then
                                    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
                                Else: GoTo 10
                                End If
                            End If
10:             Next
sayfa.Cells(1, 1).Activate
20:  Next
v.Activate
End Sub
Sub ZEHIRLI_ORGINAL()
Dim v As Worksheet: Set v = Sheets("Veri")
For Each sayfa In Worksheets
        If sayfa.Name = "Veri" Then
            GoTo 20
        End If
        sayfa.Activate
            sayı = sayfa.DrawingObjects.Count
                For sekil = 1 To sayı
                If Right(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "Bağlayıcı" Or _
                Left(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "AutoShape" Then GoTo 10
                    sayfa.Shapes.Range(Array(sekil)).Select
                        metin = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
                            If metin = "" Or _
                                WorksheetFunction.CountIf(v.Range("B6:B" & v.[B65536].End(3).Row), metin) = 0 Then
                                GoTo 10
                            Else
                            Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
                            satır = WorksheetFunction.Match(metin, v.Range("B1:B" & v.[B65536].End(3).Row), 0)
                                If v.Cells(satır, 4) = "Aktivite Yok" Then
                                    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 0)
                                Else: GoTo 10
                                End If
                            End If
10:             Next
sayfa.Cells(1, 1).Activate
20:  Next
v.Activate
End Sub

 

[Muzaffer Ali]

Merhaba.

Sub ZEHIRLI_BOYA()
    Dim v As Worksheet: Set v = Sheets("Veri")
    For Each sayfa In Worksheets
        If sayfa.Name = "Veri" Then
            GoTo 20
        End If
        sayfa.Activate
        sayı = sayfa.DrawingObjects.Count
        For sekil = 1 To sayı
            If Right(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "Bağlayıcı" Or _
                Left(sayfa.Shapes.Range(Array(sekil)).Name, 9) = "AutoShape" Then GoTo 10
                sayfa.Shapes.Range(Array(sekil)).Select
                If sayfa.Shapes.Range(Array(sekil)).Type = msoAutoShape Then
                    metin = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
                    If metin = "" Or _
                    WorksheetFunction.CountIf(v.Range("B6:B" & v.[B65536].End(3).Row), metin) = 0 Then
                    GoTo 10
                Else
                    Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
                    satır = WorksheetFunction.Match(metin, v.Range("B1:B" & v.[B65536].End(3).Row), 0)
                    If v.Cells(satır, 4) = "sorunlu" Then
                        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
                    Else
                        GoTo 10
                    End If
                End If
            End If
10:
        Next
        sayfa.Cells(1, 1).Activate
20:
    Next
    v.Activate
End Sub

 

[Korhan Ayhan]

Nesneleri aldığınız döngü içine ilk satıra aşağıdaki sorguyu ekleyin.

If sayfa.Shapes.Range(Array(sekil)).Type <> 13 Then

Döngüye ait Next satırının hemen üstüne de End If ekleyip deneyiniz.

 

[excellkurdu]

Hocalarım cevaplarınız için tşk ederim.
Allah razı olsun.

 

[Muzaffer Ali]

Allah hepimizden razı olsun inşallah.