Fußzeile mittels Makro
07.02.2014 11:32:24
Büsing
ein ähnliches Thema hatte ich bereits gestern eingestellt und habe dazu auch eine super Lösung erhalten. Nochmal danke an Franz (fsc). Leider scheint das Thema schon archiviert zu sein oder ich habe es nicht erkannt wie man darauf antworten kann.
Ich hätte in dem Makro gerne das aktuelle Datum links unten in der Fußzeile. Leider sind meine Versuche gescheitert. Ich hatte den Parametr wie folgt eingegeben .LeftFooter = "&D" aber bei der Ausührung erscheint dann der Dateipfad :-(
Hier das Makro ohne meine Versuche
Sub Arbeitsvorratsliste()
' Arbeitsvorratsliste Makro
Dim wks As Worksheet
Dim objList As ListObject
Dim strList As String
Set wks = ActiveSheet
Set objList = wks.ListObjects(1)
strList = objList.Name
wks.Columns("AM:BA").Select
Selection.Delete Shift:=xlToLeft
wks.Columns("P:AK").Delete Shift:=xlToLeft
Application.CutCopyMode = False
wks.Columns("P:P").Cut
wks.Columns("A:A").Insert Shift:=xlToRight
objList.Sort.SortFields.Clear
objList.Sort.SortFields. _
Add Key:=wks.Range(strList & "[[#All],[Zusammenf. Liegezeit]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With objList.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
wks.Cells.EntireColumn.AutoFit
objList.Range.AutoFilter Field:=3, Criteria1:=""
objList.Range.AutoFilter Field:=13, Criteria1:="ja"
Application.PrintCommunication = False
With wks.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.787401575)
.BottomMargin = Application.InchesToPoints(0.787401575)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Range("A1").Select
End Sub