Shapes löschen

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von robin5003414.

    Shapes löschen

    Hey Leute,

    habe folgenden VBA Code

    Visual Basic-Quellcode

    1. Sub schleife_max()
    2. i = 1: xmax = 0
    3. xmin = 1000
    4. i = 1: ymax = 0
    5. ymin = 1000
    6. Dim ingsz As Double
    7. Do
    8. i = i + 1
    9. If Worksheets("netzelement").Cells(i, 9) > xmax Then xmax = Worksheets("netzelement").Cells(i, 9)
    10. If Worksheets("netzelement").Cells(i, 9) < xmin Then xmin = Worksheets("netzelement").Cells(i, 9)
    11. If Worksheets("netzelement").Cells(i, 10) > ymax Then ymax = Worksheets("netzelement").Cells(i, 10)
    12. If Worksheets("netzelement").Cells(i, 10) < ymin Then ymin = Worksheets("netzelement").Cells(i, 10)
    13. Loop Until Worksheets("netzelement").Cells(i + 1, 1) = ""
    14. MsgBox "Xmax=" & xmax
    15. MsgBox "Xmin=" & xmin
    16. MsgBox "Ymax=" & ymax
    17. MsgBox "Ymin=" & ymin
    19. xdiff = xmax - xmin
    20. ydiff = ymax - ymin
    22. i = 1
    23. Do
    24. i = i + 1
    25. xakt = Worksheets("netzelement").Cells(i, 9)
    26. yakt = Worksheets("netzelement").Cells(i, 10)
    27. xd = ((xmax - xakt) / xdiff) * 1000
    28. yd = ((ymax - yakt) / ydiff) * 1000
    32. ActiveSheet.Shapes.AddShape(msoShapeOval, xd, yd, 31.5, 28.5).Select
    33. Loop Until Worksheets("netzelement").Cells(i + 1, 1) = ""
    35. End Sub


    Ich habe jetzt auf meinen sheet überall die shapes ( wie gewollt) screenshot im Anhang

    Ich bräuchte jetzt noch einen code, so dass ich die shapes einfach wieder löschen kann! Hat jemand eine idee für mich ?

    Danke
    Robin
    Dateien

    • Unbenannt.jpg

      (791,09 kB, 226 mal heruntergeladen, zuletzt: )

    Hallo,

    ich bin selber noch Neuling aber vielleicht hilft dir das weiter was ich mittels Google gefunden habe:

    Visual Basic-Quellcode

    1. Public Sub loeschen()
    2. Application.ScreenUpdating = False
    3. Dim objShape As Shape
    5. For Each objShape In ActiveWorkbook.Worksheets("Tabelle3").Shapes
    6. If Not Application.Intersect(objShape.TopLeftCell, ActiveWorkbook.Worksheets("Tabelle3").Range("J9:FC50")) Is Nothing Then
    7. objShape.Delete
    8. End If
    9. Next
    11. Application.ScreenUpdating = True
    12. End Sub


    Ich hoffe das es das ist was du suchst!
    Google spuckt noch viel mehr zum Thema Shapes Löschen aus aber ich denke das schaffst du selber ;)
    Wer fragt, ist ein Narr für eine Minute. Wer nicht fragt, ist ein Narr sein Leben lang.

    ´soo habe es hinbekommen,

    mit folgenden code

    Sub Shapes1()
    'Delete all Objects except Comments
    On Error Resume Next
    ActiveSheet.DrawingObjects.Visible = True
    ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0
    End Sub




    Danke Nochmal !

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „robin5003414“ ()

Facebook
Telefonspende