Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1656to1660
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
1656to1660
1656to1660
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code erweitern

Code erweitern
09.11.2018 20:46:10
Michael
Hallo an Alle
Schaffe es nicht unten stehenden Code auf einen bestimmten Bereich zu begrenzen. Wenn ich versuche nach objWs ein Range einzugeben, bekomme ich Fehlermeldungen. Hab es mit der Hilfe versucht, bin aber auf nichts verwertbares gestoßen.
Ziel ist es den Code auf alle Zeilen ab Zeile 21 bis Tabellenende auszuführen.
Die oberen 20 Zeilen sollen erhalten bleiben.
Wer hat eine Idee, so das es läuft.
Vielen Dank für eure Hilfe
Michael
  • 
Sub Löschen()
Dim objWs As Worksheet
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
objWs.DrawingObjects.Delete
objWs.ClearContents
objWs.RowHeight = 18.75
End If
Next
End Sub

    • 14
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: ab Zeile 20
    09.11.2018 20:58:42
    Fennek
    Hallo,
    teste mal mit
    
Range("A20", SpecialCells(xlCellTypeLastCell)).clear
    mfg
    (ungetestet)
    AW: ab Zeile 20
    09.11.2018 23:27:15
    Michael
    Hallo Fennek
    Vielen Dank für deine Antwort
    Habe versucht deinen Vorschlag in den Code einzubauen.
    Bei beiden Varianten bekomme ich die Fehlermeldung.
    Fehler beim kompilieren. Sub oder Function nicht definiert
    Vieleicht sollte ich noch sagen, das in dem Bereich ab Row 20
    nicht nur Bilder vorkommen. Das meiste ist Text,
    mit wenigen Bildern an wechselden Positionen.
    Anbei die beiden Versuche
    Sub Löschen()
Dim objWs As Worksheet
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
Range("A20", SpecialCells(xlCellTypeLastCell)).Clear
'objWs.DrawingObjects.Delete
'objWs.ClearContents
'objWs.RowHeight = 18.75
End If
Next
End Sub
Sub Löschen()
Dim objWs As Worksheet
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
objWs.Range("A20", SpecialCells(xlCellTypeLastCell)).Clear
'objWs.DrawingObjects.Delete
'objWs.ClearContents
'objWs.RowHeight = 18.75
End If
Next
End Sub

    Anzeige
    AW: Code erweitern
    10.11.2018 01:51:17
    onur
    Wenn schon, dann: 
    objWs.Cells.ClearContents

    Ausdruck . ClearContents
    Ausdruck Eine Variable, die ein Range-Objekt darstellt.
    Rückgabewert: Variant
    Ausdruck . RowHeight
    Ausdruck Eine Variable, die ein Range-Objekt darstellt.
    Hallo onur
    10.11.2018 12:26:18
    Michael
    Hallo onur
    Vielen Dank für die Info, wenn du mir sagen kannst wie ich den Code nun erst ab Zeile 20 zum Einsatz bringe, wäre das super. Wenn ich nur Cells eingebe, löscht er weiterhin die ganze Seite. Das soll aber nicht sein. Alles soll erst ab Zeile 20 passieren:
    Ziel: AB Zeile 20 - Alle Bilder löschen, Text entfernen und die Zeilenhöhe zurücksetzen. Und das auf allen Seiten die das Kriterium "BE" im Reiternamen haben.
    Vielen Dank für deine Hilfe
    Michael
    Anzeige
    AW: Hallo onur
    10.11.2018 12:45:22
    onur
    dim rng
    If Right(objWs.Name, 2) = "BE" Then
    Set rng = objWs.Range(objWs.Cells(20, 1), objWs.Cells(1000, 100))'100 Spalten, 1000 Zeilen
    rng.ClearContents
    ......
    ......
    AW: Hallo onur
    10.11.2018 15:14:43
    Michael
    Hallo onur
    Habe den Code in deinem Sinn abgeändert. ClearContents und RowHeight funktioniert jetzt einwandfrei. Nur bei DrawingObjects bekomme ich die Fehlermeldung: Methode wird nicht untertstützt
    Weißt du dazu noch einen Rat?
    Vielen Dank für deine Hilfe
    Sub Löschen()
Dim objWs As Worksheet
Dim rng
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
Set rng = objWs.Range(objWs.Cells(20, 1), objWs.Cells(1000, 100))'1000 Zeilen, 100  _
Spalten
rng.DrawingObjects.Delete  'DrawingObjects.Clear habe ich probiert
rng.ClearContents
rng.RowHeight = 18.75
End If
Next
End Sub

    Anzeige
    AW: Hallo onur
    10.11.2018 15:16:20
    onur
    Wilst du ALLE löschen oder ab Zeile 20?
    AW: Hallo onur
    10.11.2018 16:03:56
    Michael
    Ab Zeile 20, Zeilen 1-19 sollen unberührt bleiben.
    AW: Hallo onur
    10.11.2018 16:09:13
    onur
    Probiere das: 
    ....
rng.ClearContents
rng.RowHeight = 18.75
For Each Shp In rng
Shp.Delete
Next
....

    AW: Hallo onur
    10.11.2018 16:14:10
    onur
    Sorry, versuch es so:
    
dim dr
rng.ClearContents
rng.RowHeight = 18.75
For Each dr In rng.drawingobjects
dr.Delete
Next
....

    AW: Hallo onur
    10.11.2018 16:49:38
    Michael
    Hallo onur
    Der Code weigert sich immer noch. Methode wird nicht unterstützt. Oder habe ich deinen Vorschlag falsch eingefügt? Wenn ich es direkt unter rng.rowheight einfüge, meckert excel das If Block ohne End If und For ohne Next ist.
    Sub Löschen()
Dim objWs As Worksheet
Dim dr
Dim rng
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
Set rng = objWs.Range(objWs.Cells(49, 1), objWs.Cells(1000, 100))
rng.ClearContents
rng.RowHeight = 18.75
End If
Next
For Each dr In rng.DrawingObjects
dr.Delete
Next
End Sub

    Anzeige
    AW: Hallo onur
    10.11.2018 16:51:53
    onur 
    
Dim objWs As Worksheet
Dim rng, dr
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
Set rng = objWs.Range(objWs.Cells(20, 1), objWs.Cells(1000, 100)) '1000 Zeilen, 100 _
rng.ClearContents
rng.RowHeight = 18.75
For Each dr In objWs.DrawingObjects
If Not Intersect(rng, objWs.Range(dr.TopLeftCell, dr.BottomRightCell)) Is Nothing  _
Then
dr.Delete
End If
Next
End If
Next

    AW: Hallo onur
    10.11.2018 16:36:50
    onur
    Man sollte nix posten, ohne ihn zu testen - Sorry. 
    Dim objWs As Worksheet
Dim rng, dr
For Each objWs In ThisWorkbook.Worksheets
If Right(objWs.Name, 2) = "BE" Then
Set rng = objWs.Range(objWs.Cells(20, 1), objWs.Cells(1000, 100)) '1000 Zeilen, 100 _
rng.ClearContents
rng.RowHeight = 18.75
For Each dr In objWs.DrawingObjects
If Not Intersect(rng, objWs.Range(dr.TopLeftCell, dr.BottomRightCell)) Is Nothing  _
Then
dr.Delete
End If
Next
End If
Next

    Anzeige
    AW: Hallo onur
    10.11.2018 17:02:24
    Michael
    Hallo onur
    Da hat sich wohl was überschnitten, war noch mit der Antwort für deinen Vorherigen Beitrag beschäftigt, als deine Antwort schon da war.
    Jetzt läuft es Prima. Ganz vielen Dank dafür.
    Gruß
    Michael

    Beliebteste Forumthreads (12 Monate)

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

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige