AW: Tabelle Bestellung -Modul Wochenansicht
30.12.2017 00:28:40
Gerd
Hallo Lars,
soweit Buttons vorgefunden. Auf den "Application.Caller" u. "SelectedSheets" habe ich
aus Gründen der Nachvollziehbarkeit verzichtet; ebenso auf das "Schleifen" der Wochentage.
Gruß Gerd
Option Explicit
Sub woche_1()
Call WochenAnsichten(1)
Range("c5").Select
End Sub
Sub woche_2()
Call WochenAnsichten(2)
Range("m5").Select
End Sub
Sub woche_1_2()
Call WochenAnsichten(1, 2)
Range("C5").Select
End Sub
Sub woche_3()
Call WochenAnsichten(3)
Range("bk5").Select
End Sub
Sub woche_4()
Call WochenAnsichten(4)
Range("bu5").Select
End Sub
Sub woche_3_4()
Call WochenAnsichten(3, 4)
Range("BK5").Select
End Sub
Sub woche_5()
Call WochenAnsichten(5)
Range("DS5").Select
End Sub
Sub WochenAnsichten(Woche As Long, Optional weitereWoch As Long)
Dim w(1 To 5) As Range
Dim wGesamte As Range
Dim NR As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Spalten für w1 - w5
Set w(1) = Range("A:J,U:AD,AO:AX")
Set w(2) = Range("K:T,AE:AN,AY:BH")
Set w(3) = Range("BI:BR,CC:CL,CW:DF")
Set w(4) = Range("BS:CB,CM:CV,DG:DP")
Set w(5) = Range("DQ:DZ,EA:EJ,EK:ET")
Set wGesamte = Union(w(1), w(2), w(3), w(4), w(5))
'w1-5 Spalten ausblenden
wGesamte.EntireColumn.Hidden = True
'betreffende Wochenspalten einblenden
w(Woche).EntireColumn.Hidden = False
If weitereWoch > 0 Then w(weitereWoch).EntireColumn.Hidden = False
With Sheets("Klädke")
'w1-w5 bei Klädke ausblenden
.Range(wGesamte.Address).EntireColumn.Hidden = True
'betreffende Wochenspalten bei Klädke einblenden
.Range(w(Woche).Address).EntireColumn.Hidden = False
If weitereWoch > 0 Then .Range(w(weitereWoch).Address).EntireColumn.Hidden = False
End With
For NR = 1 To 5
Sheets("Küche" & NR).Visible = False
Sheets("Mo. woche " & NR).Visible = False
Sheets("Di. woche " & NR).Visible = False
Sheets("Mi. woche " & NR).Visible = False
Sheets("Do. woche " & NR).Visible = False
Sheets("Fr. woche " & NR).Visible = False
Sheets("Sa. woche " & NR).Visible = False
Sheets("So. woche " & NR).Visible = False
Next
If weitereWoch = 0 Then weitereWoch = Woche
For NR = Woche To weitereWoch
Sheets("Küche" & NR).Visible = True
Sheets("Mo. woche " & NR).Visible = True
Sheets("Di. woche " & NR).Visible = True
Sheets("Mi. woche " & NR).Visible = True
Sheets("Do. woche " & NR).Visible = True
Sheets("Fr. woche " & NR).Visible = True
Sheets("Sa. woche " & NR).Visible = True
Sheets("So. woche " & NR).Visible = True
Next
For NR = 1 To 5
Set w(NR) = Nothing
Next
Erase w
Set wGesamte = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub