• 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.

Dynamische droplist met SheetNames

Status
Niet open voor verdere reacties.
SjofaaSj

SjofaaSj

Gebruiker
Lid geworden
24 feb 2014
Berichten
44
Via Celvalidatie wil ik een droplist maken die alle sheetnames bevat.
Het aantal sheets kan variëren dus ik wil dit dynamisch maken waarbij de lijst zal updaten bij selectie van het tabblad waar de droplist staat.

Mijn idee was om achter het werkblad een code te zetten die
1. de sheetnames in een array duwt (behalve deze die ik er niet in wil)
2. die array naar een named range omzet
3. waarna ik die named range kan gebruiken voor m'n droplist

Dit is de code die ik so far heb staan in een gewone module:
Code: 
Sub Sheets_SheetNamesToArray()
    Dim i As Integer
    Dim shtArray() As Variant
    Dim NoListArray As Variant
    Dim mySht As Worksheet
    Dim myNamedRange As Range
    Dim myRangeName As String
    Dim NoList1 As String, NoList2 As String
    'parameters
    myRangeName = "myShtList"
    NoList1 = UCase("Test")
    NoList2 = UCase("List")
    NoListArray = Array(NoList1, NoList2)
    '1. create array with worksheet names
    ReDim shtArray(Worksheets.Count)
    For i = 1 To Worksheets.Count
        If Not IsInArray(UCase(Worksheets(i).Name), NoListArray) Then
            shtArray(i) = Worksheets(i).Name
        End If
    Next
    '2. pass array to named range
    On Error Resume Next
    ActiveWorkbook.Names(myRangeName).Delete
    On Error GoTo 0
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=shtArray
End Sub


Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function

en deze achter het desbetreffende tabblad
Code: 
Sub Workbook_SheetActivate()
    Sheets_SheetNamesToArray
End Sub


Maar de namedRange resulteer in dit:
={#N/B"Blad1""Blad2""Blad3""Blad4"\#N/B\#N/B}​


De adder onder het gras is wellicht het omzetten vd array naar de lijst voor de named range,
maar ik heb geen idee hoe dit te verhelpen...

[het voorbeeldbestand dat ik wilde uploaden verschijnt niet in bestandenlijst die ik als bijlage kan meegeven]
[het is nochtans slechts een klein .xlsb bestand met 6 sheets waaronder 'LIST' en 'TEST']
 
Een .xlsb bestand kan je gewoon plaatsen hier en een voorbeeld is echt nodig.
 
Ik heb onderstaande code niet getest, maar zoiets zou moeten helpen om van je #N/B af te komen.

Code: 
Dim index as integer
index=1
For i = 1 To Worksheets.Count
        If Not IsInArray(UCase(Worksheets(i).Name), NoListArray) Then
            shtArray(index) = Worksheets(i).Name
index=index+1
        End If
    Next

Je telt de index van je array namelijk door, ook als je de desbetreffende sheet wil overslaan.
 
Query aangepast zoals gesuggereerd:
Code: 
Sub Sheets_SheetNamesToArray()
    Dim i As Integer
    Dim index As Integer
    Dim shtArray() As Variant
    Dim NoListArray As Variant
    Dim mySht As Worksheet
    Dim myNamedRange As Range
    Dim myRangeName As String
    Dim NoList1 As String, NoList2 As String
    'parameters
    index = 1
    myRangeName = "myShtList"
    NoList1 = UCase("Test")
    NoList2 = UCase("List")
    NoListArray = Array(NoList1, NoList2)
    '1. create array with worksheet names
    ReDim shtArray(Worksheets.Count)
    For i = 1 To Worksheets.Count
        If Not IsInArray(UCase(Worksheets(i).Name), NoListArray) Then
            shtArray(index) = Worksheets(i).Name
            index = index + 1
        End If
    Next
    '2. pass array to named range
    On Error Resume Next
    ActiveWorkbook.Names(myRangeName).Delete
    On Error GoTo 0
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=shtArray
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
en
Code: 
Sub Worksheet_Activate()
    Call Sheets_SheetNamesToArray
End Sub

Maar resultaat blijft nog steeds onbruikbaar ; in de Named Range staat
={#N/B"Blad1""Blad2""Blad3""Blad4"\#N/B\#N/B}​

Naast de '#N/B' lijkt het me ook een probleem dat de lijst in array format wordt gelezen: met { } en " " ipv komma's als lijstscheidingsteken.


@edmoor: ik weet het, ik heb het al eerder gedaan, maar nadat ik via Bijlagen > Toevoegen > Bestand Kiezen klik op 'uploaden', verdwijnt de popup wel maar komt het geselecteerde bestand niet tevoorschijn in de bestandenlijst ?
 
Klik op Ga geavanceerd en gebruik dan de paperclip om een bestand toe te voegen.
 
dat is precies wat ik gedaan heb
- geavanceerd
- bijlagen
- > toevoegen
- > bladeren
- > > bestand selecteren
- > > openen
- > uploaden
en dan verschijnt terug de bijlagen-bestandslijst zonder dat het nieuwe is opgenomen

ik wil het met alle plezier doen, maar het lukt niet
 
SjofaaSj zei:
in de Named Range staat
={#N/B"Blad1""Blad2""Blad3""Blad4"\#N/B\#N/B}​
Klik om te vergroten...

Onthoud dat je array bij 0 begint te tellen, en dus stopt bij Worksheets.Count-1.
Dat wil zeggen dat in de initalisatie je 'index=0' moet zeggen om de eerste #N/B weg te werken. En je houdt nog steeds een aantal #N/B's over aan het eind omdat je een aantal namen in je Worksheet.Count in je NoList hebt staan. Wat je zou kunnen doen is je dropdown list maar laten gaan van 0 tot index-1. Of je moet je array anders dimensioneren.

SjofaaSj zei:
Naast de '#N/B' lijkt het me ook een probleem dat de lijst in array format wordt gelezen: met { } en " " ipv komma's als lijstscheidingsteken.
Klik om te vergroten...

Zover ik kan beoordelen gaat dit wel gewoon goed eigenlijk.
 
Is zoiets niet voldoende

Code: 
Sub VenA()
  For Each Sh In Sheets
  If Sh.Name <> "Test" And Sh.Name <> "List" Then c00 = c00 & "," & Sh.Name
  Next Sh
  With Cells(1).Validation
    .Delete
    .Add 3, , , Mid(c00, 2)
  End With
End Sub
 
Cobbe zei:
@SjofaaSj Ik heb een filmpje voor u gemaakt:

https://we.tl/OyBOMKgork
Klik om te vergroten...

Heel attent Cobbe en ik had/heb precies gedaan wat je toont,
Zodra ik op de 'uploaden' knop klik, verdwijnt dat venster maar komt het bestand er niet bij.
Er staan reeds 5 bijlagen uit vorige posts, maar deze laatste kan ik met geen mogelijkheid toevoegen.

Maar de WeTransfer is een prima (zij het tijdelijk) alternatief: file staat hier https://we.tl/Lrpul8jEyv
 
VenA zei:
Is zoiets niet voldoende

Code: 
Sub VenA()
  For Each Sh In Sheets
  If Sh.Name <> "Test" And Sh.Name <> "List" Then c00 = c00 & "," & Sh.Name
  Next Sh
  With Cells(1).Validation
    .Delete
    .Add 3, , , Mid(c00, 2)
  End With
End Sub
Klik om te vergroten...


VenA, de code werkt deels, want beide excluded sheets staan nog steeds in de droplist, maar jouw stukje code is veel beknopter dan wat ik had gefabriceerd.
De reden dat ik een array wilde gebruiken is omdat ik dit ook wilde gebruiken voor een andere procedure waar reeds een array gevormd is.
Twee vliegen in één klap zeg maar.



UPDATE: sheetnames blijken hoofdlettergevoelig te zijn, als ik die aanpas zijn ze er wel uit ; werkt dus prima, waarvoor dank

desalniettemin zou de array-oplossing toch wel heel bruikbaar zijn...
 
Laatst bewerkt:
Zo beter?
Code: 
Sub VenA()
  For Each Sh In Sheets
  If Sh.Name <> "TEST" And Sh.Name <> "LIST" Then c00 = c00 & "," & Sh.Name
  Next Sh
  Sheets("LIST").Cells(3, 3).Validation.Modify 3, , , Mid(c00, 2)
End Sub
 
Works like a charm, Tx.

(komt er geen oplossing meer voor de array, dan gebruik ik deze en zet ik draadje als opgelost)
 
Om er een array van te maken

Code: 
ar = Split(Mid(c00, 2), ",")
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan