Löschen der Fusszeile in mehreren .xlsm

Forumthread: 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

Beliebteste Forumthreads (12 Monate)

Löschen der Fusszeile in mehreren .xlsm

Forumthread: Löschen der Fusszeile in mehreren .xlsm

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread