Tabelle Benutzerdefiniert formatieren
18.06.2016 00:46:48
Daniel
Ich brauch wieder mal Eure Hilfe.
Jeden Tag bekomme ich eine dynamische Lagerliste (von A7 bis ca. H400). Wegen der besseren Übersicht würde ich gern eine Lagerbestand Tabelle formatieren. Habe mit Makro Rekorder folgenden Code aufgenommen.
Sub Formatierung_Lagerbstands_ListeTest()
'Das ist mein aufgezeichnetes Makro
'Gesuchte Lösung: schreibe in Zeile "C3" Formel =Heute()
'Ganzes Tabellenblatt formatieren ohne Gitternetzlinien
'Feste engl. Begriffe Von "A6"= "Artic.Nr." bis "H6"= "Delivery" Schrift fett
'Dynamische Rahmen Linien (es soll geprüft werden: von "A6" bis zum letzte gefüllte Zeile in _
Spalte z.B. "A205" dann Rahmen Lienen von "A6:H206"
'Wie kann man über Makro Befehl Ampel Symbolsätze
'in Spalte "C" (immer von C8 bis letzter gefüllte Zeile in Spalte "C" ausführen?
'S. bitte Makro "Ampel_Symbol_Sätze"
ActiveWindow.DisplayGridlines = False
Columns("A:A").ColumnWidth = 22.29
Columns("B:B").ColumnWidth = 32
Columns("B:B").ColumnWidth = 38.71
Range("C3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("C3").Select
Selection.Font.Bold = True
Range("A6:H6").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Size = 11
Range("A6:H6").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "Artic.Nr."
Range("B6").Select
ActiveCell.FormulaR1C1 = "Products"
Range("C6").Select
ActiveCell.FormulaR1C1 = "Used by date"
Range("D6").Select
ActiveCell.FormulaR1C1 = "Euro palett"
Range("E6").Select
ActiveCell.FormulaR1C1 = "Numbr. EP"
Range("F6").Select
ActiveCell.FormulaR1C1 = "Box quantitiy"
Range("G6").Select
ActiveCell.FormulaR1C1 = "Products quantity"
Range("H6").Select
ActiveCell.FormulaR1C1 = "Delivery"
Range("C6").Select
Columns("C:C").ColumnWidth = 13.14
Columns("D:D").ColumnWidth = 14.57
Columns("D:D").ColumnWidth = 13.14
Range("D6").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D7").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:D").ColumnWidth = 9.43
Columns("D:D").ColumnWidth = 7.29
Rows("6:6").Select
Rows("6:6").EntireRow.AutoFit
Range("F6").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("F:F").ColumnWidth = 8.57
Range("G6").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A6:H6").Select
Range("H6").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A6:H50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A4").Select
Call Ampel_Symbol_Sätze
End Sub
Das Einzige was ich nicht hinkriege die Tabelle Benutzerdefiniert formatieren bezogen auf dynamische Größe (von A6 bis mal H205 oder bis H356 etc). Dazu brauche ich eine Ampel Symbolsätze (auf Datum bezogen- Mindesthaltbarkeitsdatum - MHD).
Wer kann mir folgende Prozedur in Makro anpassen.
- Wenn der Datum in Spalte C(ab C8) kleiner ist (von den heutigen Datum in C3als 55 Tagen dann soll grüne Ampel neben den Datum hinkommen
- Wenn der Datum in Spalte C(ab C8) kleiner ist (von den heutigen Datum in C3als 20 Tagen dann soll gelbe Ampel neben den Datum hinkommen
- Wenn der Datum in Spalte C(ab C8) kleiner ist (von den heutigen Datum in C3als 19 Tagen dann soll rote Ampel neben den Datum hinkommen
Sub Ampel_Symbol_Sätze()
'Wie lautet Makro der Befehl ab "C8" bis letzte gefüllte Zelle in Spalte "C"
'Solle mit Symbol (Ampel) formatiert werden? Formatstil-Symbolsätze
'(Ampel)Grün - (Wenn Wert) ">=" (Wert) =$C$3+55 Typ Formel
'(Ampel)Gelb - (Wenn =" (Wert) =$C$3+55 Typ Formel
'(Ampel) Rot - Wenn In der Mappe habe ich 2 Tabellen Blätter Vorher (Daten aus DB System) Nachher (wie es aussehen sollte).
https://www.herber.de/bbs/user/106331.xls
Wer könnte mir bitte helfen und den Makro anzupassen
Wäre super wenn mir dabei jemand helfen könnte.
Gruß Daniel