Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1540to1544
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
Inhaltsverzeichnis

Löschen der Fusszeile in mehreren .xlsm

Löschen der Fusszeile in mehreren .xlsm
08.02.2017 14:51:53
Andy
Hallo miteinander
Ich möchte gerne meinen Arbeitsaufwand verkleinern :-)
In ca. 170 Excel-Files verteilt auf 11 Ordner müsste ich ALLE .RightFooter = "" setzen. Gedient wäre mir mit einem Script, welches alle *.xlsm im selben Ordner sucht und dort in allen Worksheets den rechten Footer löscht.
Beim Suchen bin ich irgendwann verzweifelt...
Herzlichen Dank!
Gruss Andy

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Löschen der Fusszeile in mehreren .xlsm
08.02.2017 15:43:03
harry
Hallo Andy,
probier mal das aus:
Sub test()
laufwerk = "C:\DeinOrdner\"
tmp = Dir(laufwerk)
Do While Len(tmp)
Dateiname = tmp
Workbooks.Open (laufwerk & tmp)
'hier kommt Alles rein, was Du mit der Datei machen willst
ActiveSheet.PageSetup.EvenPage.RightFooter.Text = ""
ActiveWorkbook.Save
ActiveWorkbook.Close
tmp = Dir()
Loop
End Sub

AW: Löschen der Fusszeile in mehreren .xlsm
08.02.2017 15:46:05
harry
achso, hab noch gesehen in allen Sheets, dann brauchst Du noch
for each wks in worksheets
wks.PageSetup...
next

AW: Löschen der Fusszeile in mehreren .xlsm
09.02.2017 07:26:41
Andy
Hallo Harry
Vielen Dank für deinen Vorschlag.
Irgendwie passiert aber gar nichts. Es wird keine Datei geöffnet oder gespeichert (Laufwerkpfad habe ich angepasst). Auch mit deinem originalen Sub test() öffnet er keine Workbooks.
Gruss Andy
Anzeige
AW: Löschen der Fusszeile in mehreren .xlsm
09.02.2017 07:59:22
Andy
Ich habs :-)
Habe mir eine Datei (Makro.xlsm) ausserhalb des Ordners mit den zu ändernden *.xlsm erstellt und folgendes Makro eingefügt:
Sub EntfRechteFusszInOrdner() '
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.AskToUpdateLinks = False
.CalculateBeforeSave = False
End With
strPath = "C:\DeinPfad\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "*.xlsm"       'Dateiextension ggf. anpassen
Dim strFile As String
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
Dim Tabellenblatt As Worksheet
For Each Tabellenblatt In ActiveWorkbook.Worksheets
With Tabellenblatt.PageSetup
.RightFooter = ""
End With
Next Tabellenblatt
Workbooks(strFile).Close SaveChanges:=True
strFile = Dir() ' nächste Datei
Loop
End If
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.AskToUpdateLinks = True
.CalculateBeforeSave = True
End With
End Sub
Trotzdem vielen Dank für deine Idee Harry, wie du siehst hat es mich weitergebracht!
Grüsse Andy
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige