Werkbladen aanmaken

[Manke]

In mijn allereerste contact met Wigi zei hij mij “200 bladen in een Excelbestand is veel te veel”. Dat heb ik mij aangetrokken, dus wil ik er graag wat aan doen.
Het probleem is het volgende:

(zie ook afbeelding zipfile)

Mijn Excelbestand bestaat uit een veelvoud van werkbladen. Zo is er een werkblad Hoofmenu en een aantal werkbladen met Submenu’s. Via de submenu’s kan je naar het betreffende werklblad.alwaar daadwerkelijk berekeningen etc worden gemaakt.
Al met al bestaat het Excel bestand uit zo’n ‘tig werkbladen.
Normaal gesproken heb ik niet altijd alle werkbladen nodig.

Het liefst zou ik willen beginnen met een Excel bestand bestaande uit
een paar werkbladen: hoofdmenu en de submenu’s.
Wanneer ik dan een onderdeel van het submenu aanklik zou een VBA functie moeten starten die een werkblad automatisch aanmaakt (eenmalig),
Een passende naam voor het werkblad maakt en
een link op het nieuwe werkblad plaatst naar het submenu, zodat er altijd tussen het submenu en het werkblad geswitcht kan worden.

Op deze manier wordt het bestand niet groter dan nodig is.

Kan iemand mij op weg helpen? Wigi?

 

[Wigi]

Kan je het Excel bestand zelf eens bijhangen? Laat weg wat niet nodig is of wat je niet wilt op internet plaatsen. Doe enkel het essentiële als bijlage.

Ik vraag dat om de linken degelijk te kunnen leggen. Zonder linken had je de oplossing al gehad...

 

[Manke]

Hoi Wigi,

Hierbij het uitgeklede bestand.
Ik had het gemaakt voor een 19" scherm.
Alleen menu onderdeel 2.0 Kolommenbalans werkt.

Excuses voor misschien wat knullige opbouw van het spreadsheet (maar ja je leert steeds bij).

Ik ben benieuwd

 

[Wigi]

Hoi Wigi,

Hierbij het uitgeklede bestand.
Ik had het gemaakt voor een 19" scherm.
Alleen menu onderdeel 2.0 Kolommenbalans werkt.

Excuses voor misschien wat knullige opbouw van het spreadsheet (maar ja je leert steeds bij).

Ik ben benieuwd

Ik wou dat ik niets gezegd had over het aantal tabbladen :evil: Goede nieuws voor jou is dat ik er nu al een paar uren aan gespendeerd heb... Straks of morgen het resultaat.

Wigi

 

[Wigi]

Straks of morgen het resultaat.

Heb vanavond weinig anders gedaan dan code geschreven :shocked:, enneuh ... dit komt volgens mij al aardig in de buurt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim huidigBlad As Object, numb As String, TargetCell As Range

    If Target.Count > 1 Then Exit Sub

    If Target.Hyperlinks.Count > 0 Then
        'link already exists
        Target.Hyperlinks(1).Follow

    ElseIf InStr(Target, " - ") > 0 Then
        Set huidigBlad = ActiveSheet

        'make the new sheet
        numb = Mid(Target, 1, InStr(Target, " - ") - 1)
        Worksheets.Add(Before:=Sheets(1)).Name = numb

        With Sheets(numb)
            .Tab.ColorIndex = 6
            .Rows(1).Hidden = True
            With .Range("A2")
                .Select
                .Formula = _
                    "=CONCATENATE('" & huidigBlad.Name & "'!" & Target.AddressLocal(False, False) & ",""        "",WELKOM!E6,"" - "",WELKOM!D11,"", Boekjaar: "",WELKOM!E14)"
                .EntireRow.RowHeight = 18.75
            End With

            'create a link back from the new sheet to the higher level
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & huidigBlad.Name & "'!" & Target.Address, ScreenTip:=""
            Selection.Hyperlinks(1).ScreenTip = "Terug naar submenu."

            With .Range("A3")
                .FormulaR1C1 = "=CONCATENATE(""Medewerker: "",HOOFDMENU!R[6]C[3])"
                .EntireRow.RowHeight = 18.75
                'format cell A3
                With .Font
                    .Name = "Times New Roman"
                    .Bold = True
                    .Underline = xlUnderlineStyleNone
                    .Size = 8
                    .ColorIndex = 1
                End With
                .Interior.ColorIndex = xlNone
            End With
        End With

        With huidigBlad
            .Select
            Target.Select

            'create a link to the new sheet
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & numb & "'!A1"
            Selection.Hyperlinks(1).ScreenTip = "Klik hier om door te gaan."

            'format the cell with the link (target)
            With Target.Font
                .Name = "Times New Roman"
                .Bold = True
                .Underline = xlUnderlineStyleNone
                .Size = 14
                .ColorIndex = 2
            End With

            With Target.Interior
                .ColorIndex = 41
                .Pattern = xlSolid
            End With
        End With

        With Sheets(numb)
            .Select
            With .Range("A2")
                'format cell A2
                With .Font
                    .Name = "Times New Roman"
                    .Bold = True
                    .Underline = xlUnderlineStyleSingle
                    .Size = 12
                    .ColorIndex = 1
                End With
                .Interior.ColorIndex = xlNone
            End With
        End With
    End If
    Application.ScreenUpdating = True
End Sub

Hoe werkt het? We gaan uit van je bijgevoegde bestand hierboven.

Delete de hyperlinks van de onderdelen van 2.0 (dus 5 in totaal) door telkens rechts klikken en dan "Hyperlink verwijderen" te nemen.

Vervolgens plak je de geschreven code (weeral meer RSI voor mij ) achter het blad van 2.0. Telkens als je een andere cel selecteert wordt die code uitgevoerd. Wat de code doet, is eerst kijken of er een link zit in de aangeklikte cel. Als ja, volg de link dan. Als neen, maak een nieuw blad aan volgens jouw behoeften. Er wordt een link naar dat blad voorzien, en tevens een link vanuit het nieuwe blad terug naar het overzichtsblad.

Probleem zit hem in het feit dat als er al een link is, maar dat het blad dat erbij past, verwijderd is of hernoemd is. Dan krijg je een foutmelding. Je verwijdert de link, en klikt opnieuw die cel aan zodat de code opnieuw de link legt en het tabblad aanmaakt.

Lukt het?

Wigi

 

[Manke]

Hey Wigi,
Ik ben nog niet aan het sleutelen geweest, dat gebeurt zeker nog vandaag, maar nu al wil ik je bedanken voor het feit dat je zolang voor me aan het werk bent geweest.

Je hoort van me!

Groet,

Manke

 

[Manke]

Hoi Wigi,

Ik kon het niet laten om het gelijk even uit te proberen (en mijn vrouw maar roepen "Koffie is klaar!").
Maar helaas weinig resultaat.
Ik open het excel bestand,
Verwijder alle links in 2.0
Druk op Alt F11 en plak jouw script er in (ik moet de inhoud ervan nog bestuderen)

Ook heb ik bovenstaande gedaan + de werkbladen 2.01, 2.02 etc verwijderd.

Geen resultaat.
Je animated string werkt wel

Doe ik iets verkeerd? Enne geen uren meer aan zitten hoor!

Groet

Marco

 

[Wigi]

Waar heb je de code geplakt? Ik bedoel, in welk onderdeel van je bestand?

 

[Manke]

Hey Wigi, ik heb m'n koffie op en daardoor zie ik ook weer wat scherper... ik was iets vergeten mee te kopieeren.... HET WERKT!!

Perfect gedaan! Echt mijn dank is groot.

Ik zal wel lettertje voor lettertje je script moeten lezen om het te begrijpen en het zo te kunnen aanpassen voor de andere onderdelen in het menu, maar je hebt een groots werk verzet.

Heel erg bedankt! Mocht ik een vraag over je script hebben (iets niet begrijpen) dan kan ik de vraag stellen he?

Groeten en alvast hele fijne feestdagen toegewenst!

Marco (Manke)

 

[Wigi]

Heel erg bedankt! Mocht ik een vraag over je script hebben (iets niet begrijpen) dan kan ik de vraag stellen he

Dat is idd de bedoeling van een forum...

Graag gedaan, al heeft het veel tijd gekost. Heb er zelf ook wat uit geleerd.

 

[Manke]

Fijn te lezen!
Enne, ik zit me nog steeds over je werk te verbazen!

Manke

 

[jofred]

Manke/Wigi,

Ik heb met belangstelling gekeken naar dit topic :thumb:
In bijgevoegd bestandje vinden jullie een oplossing voor evt. hyperlinks naar verwijderde werkbladen. Mijn aanpassingen heb ik voorzien van commentaar om het zoeken naar de verschillen te vereenvoudigen.
De procedure verwijderd de automatisch aangemaakte hyperlinks. Deze procedure gaat automatisch af aan het slot van de controle of een nieuwe link moet worden aangemaakt, maar je kunt hem natuurlijk op andere wijze gaan aanroepen.
Overigen de code voor het automatisch aanmaken van werkblad moet je plaatsen in elk werkblad dat menu-opties bevat, dus stel dat je in werkblad 2.0 nog meer opties wilt toevoegen, dan moet je ook hier de code van Wigi plaatsen.

Overigens gaf bij mij de aanroep ".Tab.ColorIndex = 6" een foutmelding. Deze heb ik dus maar uitgecommentarieerd

Groetjes

jofred

 

[Wigi]

Bedankt Jofred

Ik zou nog

Dim h as Hyperlink

aan het begin zetten, en ook

Bestaat = False

net nadat je de For Next lus in gaat (en niet op het einde) in de module.

Voor de rest: toppie :thumb:

Wigi

 

[jofred]

Wigi

Met je tweede opmerking over

Bestaat = False

bedoel je dit ?

Sub Linktest()
'procedure om autmatische aangemaakte hyperlinks, die verwijzen naar een niet meer
'bestaand werkblad te verwijderen
Dim wsh As Worksheet
Dim Bestaat As Boolean
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
    'we testen alleen de automatisch aangemaakte hyperlinks eindigend op "A1"
     Bestaat = False
     If h.Name Like "*A1" Then
        For Each wsh In ThisWorkbook.Sheets
            If h.Name = "'" & wsh.Name & "'!A1" Then
               'hij bestaat
               Bestaat = True
               Exit For
            End If
        Next
        'werkblad bestaat niet meer en de link wordt verwijderd
        If Bestaat = False Then
            h.Delete
        End If
    End If
Next
End Sub

 

[Wigi]

Dat bedoelde ik ja.

Dit

If Bestaat = False Then
            h.Delete
        End If

kan trouwens korter (= minder typwerk)

If Bestaat = False Then h.Delete

Wigi

 

[Manke]

Hey Wigi en Jofred,

Ik kom hier maar even niet tussen... dit is nog even hogere wiskunde voor mij, maar ik ga me er in vast bijten en hoop binnenkort alles te begrijpen.

Jofred, ook jij bedankt dat je je in de kwestie verdiept hebt!:thumb:

Groet,

Manke

 

[Wigi]

Zolang je maar door de bomen het bos blijft zien Anders: alarmbel trekken