Shape löschen

[awr]

Hallo Zusammen,
 ich habe folgendes Problem.
-Ich erstelle im Programmablauf mittel VBA einen Wordart - das geht.
-Nun möchte ich das Wordard später im Ablauf wieder löschen - und das bekomme ich nicht hin:
Grund: Das Objekt hat bei jedem Erstellen einen anderen Namen. Beim erstenmal "Rechteck 1" dann beim zweiten Durchlauf "Rechteck 2" etc

Wenn ich in der Löschroutine genau die Nummer eingebe geht es - aber diese Nummer habe ich nicht da diese ja beliebig sein kann. Wenn der User zuvor schon mit was anderem in Excel gearbeitet hat beginnt die Zählung z.B mit "Rechteck 20"

Wie kann ich das lösen - ich denke daran dem Shape/Wordart einen festen Namen zu geben. nur wie ??

( Windows 7 und Excel 2010)

Danke Andreas

[Rabe]

Hi,

Wenn ich in der Löschroutine genau die Nummer eingebe geht es - aber diese Nummer habe ich nicht da diese ja beliebig sein kann.

so?

     Sheets("Tabelle1").Shapes.SelectAll
     Selection.Cut

[awr]

Hi,
das klingt einfach und logisch - werde ich probieren und berichten

Andreas

[awr]

Hi,
jep es geht und erfüllt seinen Zweck

DANKE

Andreas

[awr]

Hi,
ich war zu voreilig, es geht zwar - aber löscht natürlich alle Shapes -
Nur mein Problem ist jetzt, dass ich auf der Seite eine Grafik habe die natürlich nicht gelöscht werden darf.

Nun brauche ich nochmals eure Ideen.

Danke

[Zwergel]

Hi,

selektiere nicht alle Shapes wie im Code, sondern laufe in einer Schleife über alle Shapes und wenn nicht deine Grafik (Bezeichnung dafür kannst du ja vorher feststellen), dann löschen, wenn Grafik eben nicht.

[schauan]

Hallöchen,

ich habe hier mal zwei codes. Der erste gibt Dir alle Bildernamen im Dirketfenster aus, der zweite löscht z.B. alle Bilder außer dem, welches "Picture 1" heißt.

Code:

Sub test1()
'Variablendeklaration
Dim Bilder As Shape
'Schleife ueber alle Shapes des aktiven Blattes
For Each Bilder In ActiveSheet.Shapes
  'Ausgabe des Namens im Direktfenster
  Debug.Print Bilder.Name
'Ende Schleife ueber alle Shapes
Next
End Sub

Sub test2()
'Variablendeklaration
Dim Bilder As Shape
'Schleife ueber alle Shapes des aktiven Blattes
For Each Bilder In ActiveSheet.Shapes
  'Loeschen aller Bilder ausser Picture 1
  If Bilder.Name <> "Picture 1" Then Bilder.Delete
'Ende Schleife ueber alle Shapes
Next
End Sub

[Kuwer]

Hallo,

der TE schrieb doch, dass der Shapename nicht jedesmal gleich ist.
Das Problem ist also, beim Erstellen des Shapes einen Namen festzulegen bzw. den jeweiligen Namen zu merken.
Wenn Du, Andreas, den Code für das Erstellen zeigen würdest, könnten wir konkret helfen.

Gruß Uwe

[schauan]

Hallöchen,

man könnte ja auch das Bild, welches nicht gelöscht werden soll, zuerst anklicken, den Namen des selektierten Bildes - wie Uwe schrieb - merkt sich der Code dann automatisch, und alle anderen werden gelöscht.

[awr]

Hallo Zusammen,
danke für eure Ideen
ich habe es jetzt so gelöst, dass dem Shape am ende einfach ein fester Namen zugewiesen wird. Den kann ich dann genau ansprechen / löschen. Hier der Code (noch im Testzustand)

Code:

Sub Sample()
'

'

'
 ActiveSheet.Shapes.AddTextEffect(msoTextEffect8, "Hier steht Ihr Text.", _
       "+mn-lt", 54, msoTrue, msoFalse, 394.4577952756, 225.2740944882).Select
   With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 20).Font.Fill
       .Visible = msoTrue
       .ForeColor.ObjectThemeColor = msoThemeColorAccent1
       .ForeColor.TintAndShade = 0.9700000286
       .ForeColor.Brightness = 0
       .Transparency = 0.8999999985
       .Solid
   End With
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
       "Muster / Sample"
   With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 15). _
       ParagraphFormat
       .FirstLineIndent = 0
       .Alignment = msoAlignCenter
   End With
   With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 15).Font
       .Bold = msoTrue
       .Caps = msoNoCaps
       .NameComplexScript = "+mn-cs"
       .NameFarEast = "+mn-ea"
       .Shadow.Visible = msoTrue
       .Shadow.Style = msoShadowStyleInnerShadow
       .Shadow.Blur = 4.0078740157
       .Shadow.OffsetX = -2.1435914233
       .Shadow.OffsetY = -2.1435914233
       .Shadow.ForeColor.RGB = RGB(0, 0, 0)
       .Shadow.Transparency = 0.3999999762
       .Fill.Visible = msoTrue
       .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
       .Fill.ForeColor.TintAndShade = 0.9700000286
       .Fill.ForeColor.Brightness = 0
       .Fill.Transparency = 0.8999999985
       .Fill.Solid
       .Size = 54
       .Line.Visible = msoTrue
       .Line.ForeColor.ObjectThemeColor = msoThemeColorAccent1
       .Line.ForeColor.TintAndShade = -0.9750000238
       .Line.ForeColor.Brightness = 0
       .Line.Transparency = 0.9350000024
       .Line.Weight = 1.062992126
       .Line.DashStyle = msoLineSolid
       .Line.Style = msoLineSingle
       .Name = "+mn-lt"
       .Spacing = 0.5
   End With
   Selection.ShapeRange.IncrementRotation 316.1059833333
   Selection.ShapeRange.IncrementLeft -448.4379527559
   Selection.ShapeRange.IncrementTop -89.6603149606
   Selection.ShapeRange.IncrementLeft -25.1320472441
   Selection.ShapeRange.IncrementTop 44.8302362205
   
   
 Selection.ShapeRange.Name = "sample"
   
   
   Range("A1").Select
End Sub

zum Löschen dannn das:

Code:

Sub Sample_loeschen()
'
 ActiveSheet.Shapes("sample").Select
   Selection.Delete
 
End Sub

Nochmals Danke für eure Bemühungen

Andreas