Index pagina

[jansbl]

Hallo,

Ik gebruik Excel voor planningsdoeleinden. Het werkboek bestaat uit 53 bladen: 1 voor elke week van het jaar. De rijen kunnen namen voorstellen, de kolommen de dagen van de week.
Als extra sheet heb ik een index pagina. 54 kolommen: 1 voor elke week en de linkerkolom voor in te vullen criteria.
De bedoeling is als volgt: In de linker kolom v.d. indexpagina zet ik bijv. een aantal plaatsnamen. Een macro moet nu alle week-sheets controleren of daar die plaatsnamen voorkomen. Vervolgens wordt er, op de indexpagina, in de kolom met daarboven het juiste weeknummer een 'X' gezet met een hyperlink naar de weekpagina en cel.
Als er op de weekpagina de (bijv.) plaatsnaam vaker voorkomt, dan is slechts 1 kruisje met hyperlink voldoende. Er moet wel opnieuw een kruisje met link worden gezet op de indexpagina, als de zoekterm ook in een andere week voorkomt.

Ik hoop dat ik het duidelijk genoeg heb uitgelegd.
Het werkboek is bijgevoegd.

Bij voorbaat al bedankt voor suggesties.

Jans

 

[Wigi]

Jans

Jouw code genereert foutmeldingen als iemand het bestandje wil openen:

Sheets("LOGBOEK").Select
Application.CommandBars("Planning").Visible = True

Nodigt niet echt uit tot helpen natuurlijk

Wigi

 

[Wigi]

Allé vooruit dan maar.

Sub LinksAanleggen()
    
    Dim r As Range
    Dim wsOverzicht As Worksheet
    Dim ws As Worksheet
    Dim rFoundCell As Range
    
    Const sSheetsOverz As String = "Jaaroverzicht"
    
    Set wsOverzicht = Sheets(sSheetsOverz)
    
    For Each r In wsOverzicht.Range("A7:A" & wsOverzicht.Range("A" & Rows.Count).End(xlUp).Row)
    
        For Each ws In ThisWorkbook.Sheets
        
            If ws.Name <> wsOverzicht.Name Then
            
                Set rFoundCell = ws.Cells.Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
                
                If Not rFoundCell Is Nothing Then
                    
                    wsOverzicht.Hyperlinks.Add Anchor:=r.Offset(, CLng(ws.Name)), Address:="", _
                        SubAddress:="'" & ws.Name & "'!" & rFoundCell.Address(0, 0, xlA1), TextToDisplay:="X"
                    
                End If
                
            End If
        
        Next
        
    Next
    
    MsgBox "Klaar!", vbInformation
    
End Sub

Wigi

 

[jansbl]

Jans

Jouw code genereert foutmeldingen als iemand het bestandje wil openen:

Sheets("LOGBOEK").Select
Application.CommandBars("Planning").Visible = True

Nodigt niet echt uit tot helpen natuurlijk

Wigi

Dat was niet zo handig natuurlijk.
Ik had wat extra bladen verwijderd, om het e.e.a. compact te houden.
Even niet aan de bijbehorende codes gedacht.

Jans

 

[jansbl]

Allé vooruit dan maar.

Sub LinksAanleggen()

..........................

Wigi

Het werkt geweldig Wim,

Dank je wel.

Jans.