Steuerelemente entfernen bei speichern unter als *xlsx

Question

Hallo,

meine erste Datei mit Makros habe ich dank EUCH ganz schön "zusammengebastelt".

Jetzt hätte ich noch eine Kleinigkeit: Beim Befehl Datei speichern unter möchte ich gern die Steuerelemente entfernen (löschen oder verbergen).
Aus dem Makro heraus soll mit dem Befehlt speichern unter eine neue Datei erstellt werden; momentan sind die Steuerelemente noch ohne Funktion zu sehen.

[url]https://supportnet.de/t/2508703[/url]

Einen Befehl, den ich [xurl=https://supportnet.de/ssd|SSD Festplatte einbauen und optimieren]einbauen[/url] könnte, habe ich schon gefunden.

ActiveSheet.Shapes.SelectAll
Selection.Delete

Allerdings sollen die Buttons nur in der *xlsx Version gelöscht oder verborgen werden und nicht in der Vorlage (*xlsm) - also bei einem Abbruch soll nichts gelöscht oder verborgen werden.

Answer 1

Hallo happy1998,

da du die Datei ja über das Makro speicherst, würde ich das auch dort einbauen:

[code]Sub name()

Dim strName As String
Dim strDatei As String

strName = Year(Date)

If Month(Date) < 10 Then
 strName = strName & "_0" & Month(Date)
Else
 strName = strName & "_" & Month(Date)
End If

If Day(Date) < 10 Then
 strName = strName & "_0" & Day(Date)
Else
 strName = strName & "_" & Day(Date)
End If

strName = strName & "_" & Left(Range("AZ26"), 5) & "_" & Left(Range("AZ29"), 5) & "_" & Left(Range("AZ30"), 5) & ".xlsx"

'Benachrichtungen ausschalten
Application.DisplayAlerts = False

Datei = Application.GetSaveAsFilename(InitialFileName:=strName, fileFilter:="Excel-Arbeitsmappe, *.xlsx")
'falls Abbruch gewählt wird, dann Makro beenden
If Datei = False Then Exit Sub
'Shapes entfernen
ActiveSheet.Shapes.SelectAll
Selection.Delete
'als xlsx Datei speichern
ActiveWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbook

'Benachrichtungen wieder einschalten
Application.DisplayAlerts = True

End Sub[/code]
Gruß
M.O.

Answer 2

Hallo M.O.,

danke für die Hilfe!
Bekomme eine Fehlermeldung bei Zeile:

[b]ActiveSheet.Shapes.SelectAll[/b]

Ist nicht die originäre Datei aktiv (die mit *xslm?)

Answer 3

Hallo happy1998,

bei mir funktioniert das Makro ohne Fehler (selbst wenn im aktiven Blatt keine Shapes vorhanden sind).
Welche Fehlermeldung kommt denn außerdem?

Gruß

M.O.

Answer 4

Halle M.O.,

habe herausgefunden, dass es wohl am Blattschutz liegt!
Sorry - hatte ich nicht sofort erkannt.

Das Tabellenblatt (incl. Steuerelemente) sollte einen Blattschutz haben. D.h. der Schutz für die Steuerelemente sollte für das Löschen deaktiviert werden...

Answer 5

Hallo happy1998,

dann mach es so:

[code]Sub name()

Dim strName As String
Dim strDatei As String

strName = Year(Date)

If Month(Date) < 10 Then
 strName = strName & "_0" & Month(Date)
Else
 strName = strName & "_" & Month(Date)
End If

If Day(Date) < 10 Then
 strName = strName & "_0" & Day(Date)
Else
 strName = strName & "_" & Day(Date)
End If

strName = strName & "_" & Left(Range("AZ26"), 5) & "_" & Left(Range("AZ29"), 5) & "_" & Left(Range("AZ30"), 5) & ".xlsx"

'Benachrichtungen ausschalten
Application.DisplayAlerts = False

Datei = Application.GetSaveAsFilename(InitialFileName:=strName, fileFilter:="Excel-Arbeitsmappe, *.xlsx")
'falls Abbruch gewählt wird, dann Makro beenden
If Datei = False Then Exit Sub
'Prüfen, ob Blattschutz vorhanden ist und falls ja, dann Blattschutz aufheben:
With ActiveSheet
  If .ProtectContents = True Then .Unprotect "Passwort"
  'Shapes entfernen
  .Shapes.SelectAll
  Selection.Delete
  'Blattschutz wieder aktivieren
 .Protect "Passwort"
End With
'als xlsx Datei speichern
ActiveWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbook

'Benachrichtungen wieder einschalten
Application.DisplayAlerts = True

End Sub[/code]
Statt Passwort musst du natürlich das Passwort eingeben, das du für den Blattschutz vergeben hast. Falls du kein Passwort vergeben hast dann lässt du die Anführungszeichen und das Passwort ganz weg.

Gruß

M.O.

Answer 6

Hi M.O.,
das hat's gelöst. Mein Passwort steht zwar im Text ist aber auch "geschützt".

Danke

Answer 7

Hallo happy1998,

gern geschehen und danke für die Rückmeldung.

Gruß

M.O.