Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shapes delete

Shapes delete
27.10.2007 20:56:00
Ernst
Guten Abend Forum
Habe folgendes Makro mit dem Recorder erstellt.

Private Sub BilderLöschen ()
ActiveSheet.Shapes.Range(Array("picD95","picL95").Select
Selection.Delete
End Sub


Wie müsste der Code angepasst werden, um die Bilder in Spalte D und L , 15 Zeilen über der letzen Zeile zu löschen. Der Bereich darf aber nicht unter die Zeile 76 gehen!
Bitte um Hilfe.
Mit freundlichen Grüßen
Ernst Dunkel

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Shapes delete
27.10.2007 21:43:00
Josef
Hallo Ernst,
probier mal.
Private Sub BilderLöschen()
Dim objShp As Shape
Dim lngMax As Long

lngMax = Application.Min(76, Cells(Rows.Count, 4).End(xlUp).Row - 15)

For Each objShp In ActiveSheet.Shapes
    If objShp.Type = 13 Then
        If Not Intersect(Range("D1:D" & lngMax, "L1:L" & lngMax), objShp.TopLeftCell) Is Nothing Then
            objShp.Delete
        End If
    End If
Next

End Sub

Gruß Sepp

Anzeige
Laufzeitfehler
27.10.2007 22:05:00
Ernst
Guten Abend Sepp
Vielen Dank, dass Du mir hilfst.
Es kommt leider einen Laufzeitfehler (1004) auf Zeile: objShp.Delete
mfg
Ernst Dunkel

Blattschutz? o.T.
27.10.2007 22:10:03
Josef
Gruß Sepp

.Name = "pic" & ActiveCell.Address(0, 0)
27.10.2007 22:39:00
Ernst
Hallo Sepp
Entschuldige den aktiven Blattschutz habe ich übersehen.
Habe Dir was nicht mitgeteilt. Das bzw. die eingefügten Bilder in D bzw. der L Spalten werden benannt, siehe Code unten, dadurch werden sie nicht gelöscht!
Darf ich Dich nochmals belästigen?
Gruss
Ernst Dunkel

Private Sub CommandButton1_Click()
Dim pic As Picture
Worksheets("U-Werte").Unprotect (" ")
If img.Tag  "" Then
On Error Resume Next
ActiveSheet.Shapes("pic" & ActiveCell.Address(0, 0)).Delete
On Error GoTo 0
Set pic = ActiveSheet.Pictures.Insert(img.Tag) 'Aus dem "Tag" des Images den Pfad auslesen
With pic
.Name = "pic" & ActiveCell.Address(0, 0)
.Top = ActiveCell.Top + 2
.Left = ActiveCell.Left
End With
Set pic = Nothing
End If
frm_BA.Hide
Worksheets("U-Werte").Protect (" ")
End Sub


Anzeige
AW: .Name = "pic" & ActiveCell.Address(0, 0)
28.10.2007 07:40:00
Josef
Hallo Ernst,
na dann versuch's mal so.
Private Sub BilderLöschen()
Dim objShp As Shape
Dim lngMax As Long

lngMax = Application.Min(76, Cells(Rows.Count, 4).End(xlUp).Row - 15)

Worksheets("U-Werte").Unprotect (" ")

For Each objShp In ActiveSheet.Shapes
    If Left(objShp.Name, 3) = "pic" Then
        If Not Intersect(Range("D1:D" & lngMax, "L1:L" & lngMax), objShp.TopLeftCell) Is Nothing Then
            objShp.Delete
        End If
    End If
Next

Worksheets("U-Werte").Protect (" ")

End Sub


Gruß Sepp

Anzeige
AW: .Name = "pic" & ActiveCell.Address(0, 0)
28.10.2007 12:23:36
Ernst
Guten Tag Sepp
Hättest nicht extra so früh aufstehen müssen!
Habe Deinen Code unten auf Max abgeändert.
lngMax = Application.Min(76, Cells(Rows.Count, 4).End(xlUp).Row - 15)
lngMax = Application.Max(76, Cells(Rows.Count, 4).End(xlUp).Row - 15) 'geändert
Nun löscht es die Bilder über dem Bereich der letzten Zeile alle.
Will aber nicht alle löschen, sondern nur gerade diejenige, von der letzen Zeile an beginnen um 15 Zeilen nach oben, diejenige darüber dürfen nicht gelöscht werden!
mfg
Ernst Dunkel

AW: .Name = "pic" & ActiveCell.Address(0, 0)
28.10.2007 16:29:09
Josef
Hallo Ernst,
dann würde ich es so machen.
Private Sub BilderLöschen()
Dim objShp As Shape
Dim rng As Range
Dim lngMax As Long, lngMin As Long

With Worksheets("U-Werte")
    
    .Unprotect (" ")
    
    lngMax = Application.Min(76, .Cells(Rows.Count, 4).End(xlUp).Row - 15)
    lngMin = lngMax - 15
    
    Set rng = Union(.Range(.Cells(lngMin, 4), .Cells(lngMax, 4)), _
        .Range(.Cells(lngMin, 12), .Cells(lngMax, 12)))
    
    For Each objShp In .Shapes
        If Left(objShp.Name, 3) = "pic" Then
            If Not Intersect(rng, objShp.TopLeftCell) Is Nothing Then
                objShp.Delete
            End If
        End If
    Next
    
    .Protect (" ")
    
End With

End Sub

Gruß Sepp

Anzeige
Max
28.10.2007 21:37:00
Ernst
Guten Abend Sepp
Ich hoffe, dass Du ein schönes Wochenende hattest.
Der Code funktioniert nun, so wie ich es mir vorgestellt habe.
Recht herzlichen Dank und eine tolle Woche.
Ernst Dunkel

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige