Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Shapes mit Text suchen und ausschneiden

Shapes mit Text suchen und ausschneiden
Peter
Liebes Forum,
in unterschiedlichen Tabellen habe ich shapes mit dem Text "ABC". Nun möchte ich in allen Arbeitsblättern alle shapes löschen, die den Text "ABC" beinhalten.
Wie könnte der Code dazu aussehen?
Vielen Dank für Eure Antworten
Peter
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Shapes mit Text suchen und ausschneiden
27.02.2012 23:17:15
dan
Hallo Peter,
hier eine Meoglichkeit: die sheets und Shapes in for-each durchgehen and wenn der Text im Shape vorhanden ist, dann in ein Array ablegen. Dan ShapeRange bilden und Delete auf dem ShapeRange rufen.
Heir habe ich eine Funktion vom 'Pearson Software Consulting Services' benutzt. Mfg. dan, cz.
Option Explicit
Option Base 0
Private Const boxTitle As String = "Delete shapes"
Public Sub DeleteShapesByText()
On Error GoTo errDeleteShapes
Dim searchedText As String
searchedText = VBA.InputBox("Enter searched text:", boxTitle)
If (searchedText = "") Then
MsgBox "No shapes deleted", vbInformation, boxTitle
Exit Sub
End If
Dim oneSheet As Worksheet
Dim oneShape As Shape
Dim deleteCount As Integer
Dim deleteShapes() As Variant
Dim deleteShapesRange As ShapeRange
Dim i As Integer
For Each oneSheet In Worksheets
Erase deleteShapes
For Each oneShape In oneSheet.shapes
If (VBA.Strings.InStr(oneShape.TextEffect.Text, searchedText) > 0) Then
ReDim Preserve deleteShapes(i)
deleteShapes(i) = oneShape.Name
i = i + 1
End If
Next oneShape
If (IsArrayAllocated(deleteShapes)) Then
Set deleteShapesRange = oneSheet.shapes.Range(deleteShapes)
deleteCount = deleteCount + deleteShapesRange.Count
deleteShapesRange.Delete
End If
Next oneSheet
MsgBox "Deleted shapes count: " & deleteCount, vbInformation, boxTitle
Exit Sub
errDeleteShapes:
MsgBox "Error in 'DeleteShapes': " & Err.Description & " [" & Err.Number & "]", vbCritical,  _
boxTitle
End Sub
'
' http://www.cpearson.com/excel/vbaarrays.htm
'
Public Function IsArrayAllocated(Arr As Variant) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has  _
been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
' This function is just the reverse of IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
Dim N As Long
On Error Resume Next
' if Arr is not an array, return FALSE and get out.
If IsArray(Arr) = False Then
IsArrayAllocated = False
Exit Function
End If
' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
N = UBound(Arr, 1)
If (Err.Number = 0) Then
' Under some circumstances, if an array
' is not allocated, Err.Number will be
' 0. To acccomodate this case, we test
' whether LBound 

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige