Rectangle'ye bağlı formüller

[Korhan Ayhan]

Ben denediğimde hata oluşmuyor. Versiyon farkı olabilir.

 

[tahsinanarat]

Korhan hocam, Selection ile ilgili bütün olasılıkları denedim ama sonuç alamadım hocam. Boş bir zamanınızda bakabilirseniz, sevinirim.

 

[Korhan Ayhan]

Seçili şekiller için aşağıdaki kodu deneyiniz.

Sub Test()
    Dim Nesne As Shape
    
    For Each Nesne In Selection.ShapeRange
        If Left(Nesne.Name, 9) = "Rectangle" Then
            If InStr(1, Nesne.DrawingObject.Formula, "exsport!H") > 0 Then
                'Nesne.Select
                Nesne.DrawingObject.Formula = Replace(Trim(Nesne.DrawingObject.Formula), "!H", "!B")
                Nesne.DrawingObject.Font.Size = 8
                Say = Say + 1
            End If
        End If
    Next
    
    If Say > 0 Then
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "Değişiklik sayısı : " & Say, vbInformation
    Else
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[tahsinanarat]

Teşekkür ederim hocam, istediğim her türlü kodlara kavuştum sayenizde, elinize sağlık.