• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

werkblad openen

Status
Niet open voor verdere reacties.
popipipo

popipipo

Meubilair
Lid geworden
21 nov 2006
Berichten
8.993
Besturingssysteem
Win11
Office versie
Office 365
Het is vandaag 13 augustus.
Als ik het bijgaande bestand open, dan wil ik graag dat het volgende gebeurd.
Het tabblad 'augustus' moet dan geopend worden.
En alleen kolommen AZ:BC moeten dan zichtbaar zijn de overige kolommen moeten ingeklapt zijn.

Bij het openen op een andere datum moet dan uiteraard een ander tabblad/ kolommen zichtbaar zijn.
 

Bijlagen

Probeer deze code eens bij het Workbook_Open event:
Code: 
Private Sub Workbook_Open()
    mnd = Format(Date, "mmmm")
    Worksheets(mnd).Activate
    dg = Application.Match(CLng(Date), Worksheets(mnd).Range("A3:XFD3"), 0)
    Worksheets(mnd).Range(Columns(1), Columns(dg - 1)).EntireColumn.Hidden = True
    Worksheets(mnd).Range(Columns(dg + 4), Columns(16384)).EntireColumn.Hidden = True
    Worksheets(mnd).Range(Columns(dg), Columns(dg + 3)).EntireColumn.Hidden = False
End Sub
 
Laatst bewerkt:
De code opent keurig de kolommen met de juiste datum.
Echter de groepering functioneert niet meer want de kolommen worden verborgen ipv ingeklapt
En kolom A tm C moeten altijd zichtbaar blijven.
Tevens heeft hij wat moeite met de scherm opbouw
Een foutje van mijn zijde was dat het bestand een 2003 formaat moet zijn.

Code wat aangepast maar werkt nog niet zoals ik het wil
 

Bijlagen

Is deze code beter?
Code: 
Private Sub Workbook_Open()
    mnd = Format(Date, "mmmm")
    Worksheets(mnd).Activate
    dg = Application.Match(CLng(Date), Worksheets(mnd).Range("A3:IV3"), 0)
    For i = 4 To 124 Step 4
        If Columns(i).ShowDetail = True Then Columns(i).ShowDetail = False
    Next i
    If Columns(dg).ShowDetail = False Then Columns(dg).ShowDetail = True
End Sub
 
De eerste testen lijken goed te gaan.
Nog wel even testen voor excel 2003

Voorlopig bedankt.
 
Het werkt ook goed in Excel 2003!!

Nog een aanvullende vraag.
Ik heb er nog een macro bijgezet.
Via deze korte macro kun je via knoppen eenvoudig naar de verschillende maanden gaan.
(ivm grootte bestand aantal maanden verwijderd)

Kunnen deze 2 stukjes gecombineerd worden zodat ook via deze macro de juiste kolommen zichtbaar zijn.
Kies je een andere maand dan de huidige dan moeten alle groepen ingeklapt zijn.
 

Bijlagen

Test deze code eens:
Code: 
Sub test()
    Application.ScreenUpdating = False
    ws = ActiveSheet.Name
    wsheet = Application.Caller
    Sheets(wsheet).Activate
    mnd = Format(Date, "mmmm")
    If wsheet = Format(Date, "mmmm") And mnd <> ws Then
        For i = 4 To 124 Step 4
            If Columns(i).ShowDetail = True Then Columns(i).ShowDetail = False
        Next i
        dg = Application.Match(CLng(Date), Worksheets(mnd).Range("A3:IV3"), 0)
        If Columns(dg).ShowDetail = False Then Columns(dg).ShowDetail = True
    End If
    Application.ScreenUpdating = True
End Sub
 
Kzou 't zo doen:

Code: 
Private Sub Workbook_Open()
    On Error Resume Next
    For j = 4 To 124 Step 4
        Sheets(MonthName(Month(Date))).Columns(j).ShowDetail = j = 4 + 4 * (Day(Date) - 1)
    Next
    Application.Goto Sheets(MonthName(Month(Date))).Cells(3, 4 + 4 * (Day(Date) - 1)), True
End Sub

+

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = MonthName(Month(Date)) Then Exit Sub
    
    Application.ScreenUpdating = False
    On Error Resume Next
    For j = 4 To 124 Step 4
        Sh.Columns(j).ShowDetail = (Sh.Name = MonthName(Month(Date)))
    Next
    Cells(3, 4).Select
End Sub
 
Laatst bewerkt:
Code: 
Private Sub Workbook_Open()
    On Error Resume Next
    For j = 4 To 124 Step 4
        Sheets(MonthName(Month(Date))).Columns(j).ShowDetail = j = 4 + 4 * (Day(Date) - 1)
    Next
    Application.Goto Sheets(MonthName(Month(Date))).Cells(3, 4 + 4 * (Day(Date) - 1)), True
End Sub
Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> MonthName(Month(Date)) Then Exit Sub
    On Error Resume Next
    For j = 4 To 124 Step 4
        Sheets(MonthName(Month(Date))).Columns(j).ShowDetail = j = 4 + 4 * (Day(Date) - 1)
    Next
    Application.Goto Sheets(MonthName(Month(Date))).Cells(3, 4 + 4 * (Day(Date) - 1)), True
End Sub

Ik heb er dit van gemaakt.

Bedankt voor alle reacties en adviezen.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan