AW: Tabelle mit Heute Wert
28.04.2009 21:59:31
Josef
Hallo René,
das geht z. B. so.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Open()
showColsByWeekNum
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub showColsByWeekNum()
Dim lngWeek As Long, lngRow As Long, varRes As Variant, lngLast As Long
lngRow = 2 'Zeile mit der KW-Anzeige, anpassen!
lngWeek = DINKwoche(Date)
With Sheets("Tabelle1") 'Tabellenname anpassen!
varRes = Application.Match(lngWeek, .Rows(lngRow), 0)
If IsNumeric(varRes) Then
.Columns.Hidden = True
.Range(.Cells(1, varRes), .Cells(1, varRes + 6)).EntireColumn.Hidden = False
Application.Goto .Cells(1, varRes), True
Else
.Columns.Hidden = False
End If
End With
End Sub
Private Function DINKwoche(ByVal Datum As Date) As Integer
Dim tmp As Date
tmp = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
DINKwoche = ((Datum - tmp - 3 + (Weekday(tmp) + 1) Mod 7)) \ 7 + 1
End Function
Gruß Sepp