Variabel weeknummer uit tabblad

[Ron001]

Allen
*
In bijlage mijn PO planlijst
*
In cel B3 zou steeds het getal dat in de naam staat van het tabblad moeten komen.
Ik heb hier onderstaande macro voor "geschreven" en deze werkt.
*

Sub tabblad()

ron = ActiveSheet.Name
Range("B3") = Replace(ron, "WEEK ", "")
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Mijn probleem is dat deze werkt bv via een knop en ik deze dan moet uitvoeren, maar dit zou automatisch moeten gebeuren bij het aanmaken van een nieuw tabblad;
bv WEEK 52

Dus:

Ik zou eigenlijk willlen dat als ik een nieuw tabblad aanmaak (bv tabblad1), dan pas ik de naam aan naar Bv WEEK 12, dit getal 12 (variabel)*moet dan in cel B3 komen te staan.
In cel B3 zit een code dat hij automatisch adhv de weeknummer de weekdagen (ma-vrij) en datums gaat aanpassen.
Als je in mijn testfile de week van getal gaat veranderen zie je dat de weekdagen/datums gaan veranderen..

Bedankt!

 

[edmoor]

Ik wil er best naar kijken maar je hebt een document geplaatst met een beveiligd VBA project.
Maar kijk eens naar Workbook_SheetActivate
Met daarin o.a.:
Replace(sh.Name, "WEEK ", "")

Bijvoorbeeld dit:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If UCase(Left(Sh.Name, 4)) = "WEEK" Then Range("B3") = Replace(Sh.Name, "WEEK ", "")
End Sub

 

[Ron001]

@ Edmoor

Sheetchange had ik al eens geprobeerd, maar bij het veranderen van tabblad moet de pc telkens een 3 tal seconden "nadenken"
Is lastig voor de gebruikers...en bij NewSheet doet hij het niet...
pas = paswoord

 

[edmoor]

Ik heb m'n vorige post wat aangepast.
Wat dat nadenken betreft, dat ligt eraan wat je allemaal doet.
Het voorbeeldje dat ik plaatste kost geen tijd.

Doe in je Beeld_Aanpassen routine ook eens Application.ScreenUpdating = False

 

[Ron001]

@ Edmoor,

Neemt inderdaad variabel getal uit tabblad, dit zou alleen nog links moeten uitgelijnd worden aub...

Doe in je Beeld_Aanpassen routine ook eens Application.ScreenUpdating = False

Kan je deze code hier ook zetten? Beginners...

 

[edmoor]

Wat bedoel je? B3 in de WEEK sheets is overal links uitgelijnd.
Die Application.ScreenUpdating = False komt al vaker voor en kan je gewoon in de Beeld_aanpassen aan het begin toevoegen en aan het einde ook maar dan op True zetten.

 

[Ron001]

Wat bedoel je? B3 in de WEEK sheets is overal links uitgelijnd.

Sorry, zat in mijn testfile, ik probeer dit morgenvroeg...

Alvast bedankt!

 

[Ron001]

@ edmoor

Code werkt en computer "denkt niet meer na bij wisselen sheets", TOP

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

If UCase(Left(Sh.Name, 4)) = "WEEK" Then Range("B3") = Replace(Sh.Name, "WEEK ", "")

Beeld_aanpassen

End Sub

en code Beeld_aanpassen

Sub Beeld_aanpassen()

 Application.ScreenUpdating = False
 ActiveWindow.Zoom = 100
 Range("AC1").Select
 ActiveWindow.SmallScroll Down:=-72
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 6
Application.ScreenUpdating = True
    
End Sub

Alleen geeeft hij nog nog een fout bij de beveiligde tabbladen, waar cel B3 onder zit.
Kan je nu in de code nog iets toevoegen (zoals wat posts hieronder "kleur tabblad") dat dit toch werkt?

Iets van .Unlock "paswoord".....

Zeer hard bedankt!

Btw als ik niet meer reageer, ik ben vanaf deze middag tot 3 januari met verlof, neemt het dan terug op...

 

[edmoor]

Maak er zoiets van:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim prc As Boolean
    
    prc = ActiveSheet.ProtectContents
    If prc Then Sh.Unprotect [COLOR="#008000"]'Evt wachtwoord[/COLOR]
    If UCase(Left(Sh.Name, 4)) = "WEEK" Then Range("B3") = Replace(Sh.Name, "WEEK ", "")
    Beeld_aanpassen
    If prc Then Sh.Protect [COLOR="#008000"]'Evt wachtwoord[/COLOR]
End Sub

 

[Ron001]

Zoiets?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim prc As Boolean
    
    prc = ActiveSheet.ProtectContents
    If prc Then Sh.Unprotect "paswoord"
    If UCase(Left(Sh.Name, 4)) = "WEEK" Then Range("B3") = Replace(Sh.Name, "WEEK ", "")
    Beeld_aanpassen
    If prc Then Sh.Protect "paswoord"
End Sub

 

[edmoor]

Dat zou moeten werken als paswoord het juiste wachtwoord is

 

[Ron001]

Mag gesloten worden, it works