commandbutton maken waarop de naam van de sheets staan

[tristi]

Beste forumleden,

Ik heb volgend probleem.

Ik werk met een exelbestand met verschillende sheets. Deze sheets worden via een macro aangemaakt aan de hand van een databestand waarin voor alle deelnemers een verantwoordelijke wordt aangeduid.

Deze sheets krijgen automatisch de naam van een verantwoordelijke met de daarbij behorende deelnemers.
Om alles wat overzichtelijk te maken heb ik op sheets 1 ("startpagina") allemaal linken gemaakt met de naam van deze verantwoordelijken naar deze sheets.

Nu worden er enkele mensen vervangen. Dit wil zeggen dat de namen met de linken op de startpagina dienen te worden gewijzigd.

Is er geen mogelijkheid om via een macro commandbuttons te maken die automatisch de naam krijgen van de sheetnaam.
Ik kan wel een commandbutton aanmaken doch niet van dit kaliber, dit gaat mijn petje te boven

Graag zou ik op jullie kennis beroep willen doen.

Alvast bedankt !!!!

Ria

 

[Logicgold]

Hoi Ria,
Kan je hier iets mee?
Plaats dit in je VBA van je startpagina.

Private Sub Worksheet_Activate()
CommandButton1.Caption = Blad2.Name
CommandButton2.Caption = Blad3.Name
CommandButton3.Caption = Blad4.Name
CommandButton4.Caption = Blad5.Name
CommandButton5.Caption = Blad6.Name
CommandButton6.Caption = Blad7.Name
CommandButton7.Caption = Blad8.Name
CommandButton8.Caption = Blad9.Name
CommandButton9.Caption = Blad10.Name
CommandButton10.Caption = Blad11.Name
End Sub


Louis.

 

[tristi]

Dag Louis,


Alvast dank voor uw reactie !!

Uw oplossing is wat voor mijn bestand betreft deels goed. hij gaat inderdaad de namen van de sheets op de buttons plaatsen en bij wijzigingen veranderen ook de namen.
Nu is het wel zo dat in mijn bestand het aantal sheets niet op voorhand te bepalen is (dat kunnen er 8,10 of zelfs meer zijn) en deze sheets worden via een macro aangemaakt volgens de opgegeven verantwoordelijken (die ook weer niet op voorhand te bepalen zijn). Alles verloopt volgens een maandelijkse invoer van data.

In uw oplossing dien ik reeds het aantal buttons te bepalen zoniet krijg ik een foutmelding. vb maak ik 10 buttons en dan verwacht hij 10 sheets.
Maakt het bestand minder dan 10 sheets aan dan krijg ik terug die fout.

Ik denk dat hier een macro moet bij passen die commandbuttons aanmaakt naargelang er sheets worden aangemaakt.

Tenminste indien dit mogelijk is?

met vriendelijke groet,

Ria

 

[Logicgold]

Ria,

Ik ben nog niet een echte Excel expert maar ik denk dat het hiermee is op te lossen.

Private Sub Worksheet_Activate()
' Veranderd automatisch de naam van de CommandButton in de naam van de Sheet
On Error Resume Next
CommandButton1.Caption = Blad2.Name
CommandButton2.Caption = Blad3.Name
CommandButton3.Caption = Blad4.Name
CommandButton4.Caption = Blad5.Name
CommandButton5.Caption = Blad6.Name
CommandButton6.Caption = Blad7.Name
CommandButton7.Caption = Blad8.Name
CommandButton8.Caption = Blad9.Name
CommandButton9.Caption = Blad10.Name
CommandButton10.Caption = Blad11.Name
End Sub

Ik hoop dat het hiermee naar wens is?
Ik verneem het graag van je.

Louis

 

[Logicgold]

Maak het maximaal aantal regels in je macro dan zal het volgens mij goed moeten gaan.:thumb:

 

[Warme bakkertje]

Hou het simpel.

Private Sub WorkSheet_Activate()
    Dim lstNames()
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    ReDim lstNames(Sheets.Count - 1)
    For i = 2 To Sheets.Count
       lstNames(i - 2) = Sheets(i).Name
    Next
    Cells(2, 1).Resize(UBound(lstNames)) = WorksheetFunction.Transpose(lstNames)
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.Goto Sheets(Target.Value).Range("A1"), True
    Cancel = True
End Sub

 

[Logicgold]

Warme bakkertje

Met die code wordt die toch niet gelinkt aan een commandbutton?

Louis.

 

[Warme bakkertje]

Aangezien het aantal werkbladen en -namen steeds wijzigt moet je als je de methode v/d CB juist wil gebruiken eerst alle bestaande buttons verwijderen EN alle daaraan gelinkte code.
Daarna moet je voor elk werkblad een nieuwe button aanmaken, de naam plaatsen en nieuwe code in de bladmodule schrijven.
Waarom dan niet simpeler een lijst aanmaken v/d aanwezige werkbladen en dmv dubbelklikken naar de betreffende sheet navigeren.

 

[Logicgold]

Rudi,
Bedankt voor je uitleg.
Zo leer ik tijdens het helpen ook zelf weer.
Louis.

 

[tristi]

Hallo Rudi,


Bedankt voor uw reactie en uw voorstel tot de oplossing van mijn probleem.

Het is visueel niet zo mooi als met buttons maar het probleem wordt hierdoor wel opgelost en is voor iedere medewerker werkbaar, waarvoor mijn dank.
Ook louis wil ik toch danken want door zijn voorstel ben ik ook weer wat wijzer geworden .

Toch nog een vraagje, ik probeer mijn eerste naam in kolom G12 te krijgen ipv A2 doch dat lukt niet.

Wat dien ik juist te wijzigen? wetende dat de telling van de sheets starten op sheet nr 7

Alvast bedankt !!!!

Ria

 

[Logicgold]

Ria,

Nog graag gedaan.
Volgens mij is dit de oplossing.

Private Sub WorkSheet_Activate()
Dim lstNames()
Range("G2:G" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
ReDim lstNames(Sheets.Count - 1)
For i = 7 To Sheets.Count '<-- geeft aan vanaf welke sheet de telling begint
lstNames(i - 7) = Sheets(i).Name
Next
Cells(12, 7).Resize(UBound(lstNames)) = WorksheetFunction.Transpose(lstNames)
'de 12 geeft aan welke rij en de 7 geeft aan welke kollom de gegevens komen
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
'zorgt ervoor dat je geen error krijgt als er geen naam van de sheet staat
Application.Goto Sheets(Target.Value).Range("G1"), True
Cancel = True
End Sub


Ik heb ook "On Error Resume Next" erbij geplaatst, omdat je anders een error krijgt als je ergens anders een dubbel klik geeft.
Ook bij de vorige versie kreeg je een error.

Louis

 

[Warme bakkertje]

Private Sub WorkSheet_Activate()
    Dim lstNames()
    Range("G2:G" & Cells(Rows.Count, [COLOR="#FF0000"]7[/COLOR]).End(xlUp).Row).ClearContents
    ReDim lstNames(Sheets.Count - 1)
    For i = 7 To Sheets.Count '<-- geeft aan vanaf welke sheet de telling begint
        lstNames(i - 7) = Sheets(i).Name
    Next
    Cells(12, 7).Resize(UBound(lstNames)) = WorksheetFunction.Transpose(lstNames)
    'de 12 geeft aan welke rij en de 7 geeft aan welke kollom de gegevens komen
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row)) Is Nothing Then
        Application.Goto Sheets(Target.Value).Range("G1"), True
        Cancel = True
    End If
End Sub

 

[Logicgold]

Sorry Rudi,

Er zit nog één klein tikfoutje in.

Private Sub WorkSheet_Activate()
    Dim lstNames()
    Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row).ClearContents
    ReDim lstNames(Sheets.Count - 1)
    For i = 7 To Sheets.Count '<-- geeft aan vanaf welke sheet de telling begint
        lstNames(i - 7) = Sheets(i).Name
    Next
    Cells(12, 7).Resize(UBound(lstNames)) = WorksheetFunction.Transpose(lstNames)
    'de 12 geeft aan welke rij en de 7 geeft aan welke kollom de gegevens komen
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("G[COLOR="#FF0000"]12[/COLOR]:G" & Cells(Rows.Count, 7).End(xlUp).Row)) Is Nothing Then
        Application.Goto Sheets(Target.Value).Range("G1"), True
        Cancel = True
    End If
End Sub

Voor de rest petje af ik heb weer wat geleerd. :thumb:

Louis

 

[Warme bakkertje]

Nog eentje dan.

Private Sub WorkSheet_Activate()
    Dim lstNames()
    Range("G[COLOR="#FF0000"]1[/COLOR]2:G" & Cells(Rows.Count, 7).End(xlUp).Row).ClearContents
    ReDim lstNames(Sheets.Count - 6)
    For i = 7 To Sheets.Count '<-- geeft aan vanaf welke sheet de telling begint
        lstNames(i - 7) = Sheets(i).Name
    Next
    Cells(12, 7).Resize(UBound(lstNames)) = WorksheetFunction.Transpose(lstNames)
    'de 12 geeft aan welke rij en de 7 geeft aan welke kollom de gegevens komen
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("G12:G" & Cells(Rows.Count, 7).End(xlUp).Row)) Is Nothing Then
        Application.Goto Sheets(Target.Value).Range("G1"), True
        Cancel = True
    End If
End Sub

 

[tristi]

Dag Louis en Rudi,

De macro werkt perfect.
Ik wil jullie van harte danken voor jullie hulp en wordt het nut van deze forum nogmaals benadrukt.

Er is hemelsbreed verschil tussen een maco opnemen en een macro schrijven laat staan hem te lezen.
Maar ik heb weer wat bijgeleerd en dat geeft weeral een goed gevoel . Ik zal zeker het forum blijven bezoeken om eventuele nuttge macro's te bestuderen en jullie aan het werk te zien .

Bedankt !!!!!!!!!!

Ria