on error goto ... çalışmıyor

[platipuss]

merhaba

ekteki dosyayı inceleyecek olursanız yapmaya calıstıgım sey parça kodlarına gore süzme yaptıgım zaman resimlerin de yanlarındaki hucrelerde kaymadan durmalarını saglamaktı

cuma gunu kodu yazdım denedim gayet guzel calısıyordu (basta sadece 5 resim ekleyerek calıstırdım) ama bugun dosyama daha fazla parcanın resmini eklediğimde yazdıgım kod hata vermeye basladı

on error goto ... kodu da çalışmıyor işin ilginç tarafı

kodları calıstırmak için parca adını baslıgında suzme işlemi yapıp parça1 ya da 2 yi secmeniz yeterli

dosyayı inceleyip problemimi cözebilirseniz cok sevinirim....

iyi çalışmalar

 

[Husgvarna]

Aşağıdaki gibi deneyin.

 Public Sub resim_goruntule()
    ActiveSheet.PageSetup.PrintComments = xlPrintInPlace
    Application.DisplayCommentIndicator = xlCommentAndIndicator
[COLOR="Red"] On Error Resume Next[/COLOR]
 For Each cmt In ActiveSheet.Comments
   On Error Resume Next
        x = cmt.Parent.Row
        y = cmt.Parent.Column

        x1 = Cells(x, y).Height

        y1 = Cells(x, y).Width

        x2 = Cells(x, y).Left

        y2 = Cells(x, y).Top

        cmt.Shape.Select True
        Selection.ShapeRange.Height = x1
        Selection.ShapeRange.Width = y1
        Selection.ShapeRange.Top = y2
        Selection.ShapeRange.Left = x2
    Next cmt
Cells(1, 1).Select
End Sub

 

[platipuss]

tesekkur ederim işe yaradı

goto calışmayınca resume next de calısmaz diye denememiştim