Excel Experts Nederland Forum

Hallo,

ik zou in een exceldocument slicers willen invoegen op maat, hiermee bedoel ik dat het aantal slicers steeds kan varieren.
Het probleem is dat ik geen variabele kan gekoppeld krijgen met een teller om deze in een do-loop funktie te gebruiken.

hoe los ik dit op?

Vriendelijke groeten
Dirk H.

Kan je laten zien wat je al hebt en aangeven wat er niet werkt?

jkpieterse schreef: ↑

07 okt 2020 20:51

Kan je laten zien wat je al hebt en aangeven wat er niet werkt?

Beste,

alvast bedankt voor uw reactie.
hier wat ik reeds geprobeerd heb.

Sub Slicers()

Dim lTel As Long
Dim lCol As Long
Dim sGro As String
Dim sSeg As String
Dim sLov As String
Dim Myrange as range

lTel = 2
Do Until Cells(lTel, 1) = ""
lTel = lTel + 1
Loop
lTel = lTel - 1
lCol = 7
Do Until Cells(1, lCol) = ""
lCol = lCol + 1
Loop

Set Myrange = Range(Cells(2, 1), Cells(lTel, lCol))
Myrange.Select

ActiveSheet.ListObjects.Add(xlSrcRange, Myrange, , xlYes).Name = _
"Tabel3"
Range("Tabel3[[#Headers],[Art Nr]]").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "_Lev Code" _
).Slicers.Add ActiveSheet, , "_Lev Code", "_Lev Code", 22.5, 81, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "Schap"). _
Slicers.Add ActiveSheet, , "Schap", "Schap", 60, 118.5, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
"Artikel Groep").Slicers.Add ActiveSheet, , "Artikel Groep", "Artikel Groep", _
97.5, 156, 144, 198.75

lCol = 7
Do Until Cells(2, lCol) = ""
sGro = Cells(2, lCol)
sSeg = Cells(2, lCol + 1)
sLov = Cells(2, lCol + 2)

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sGro). _
Slicers.Add ActiveSheet, , sGro, sGro, 135, 193.5, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sSeg). _
Slicers.Add ActiveSheet, , sSeg, sSeg, 172.5, 231, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
sLov).Slicers.Add ActiveSheet, , sLov, _
sLov, 210, 268.5, 144, 198.75
lCol = lCol + 5
Loop


End Sub

De bedoeling is om telkens 3 slicers te creeëren in een blok van 5 kolommen. De eerste 3 in het voorbeeld zijn basiskolommen die vast staan. (deze staan in de eerste 6 kolommen van het werkblad). Vanaf kolom 7 heb ik blokken van 5 kolommen en wil ik de eerste 3 van elk blok met een slicer voorzien. (het aantal blokken van 5 kolommen kan variëren van 1 tot 10 blokken).

Hoop dat ik het een beetje duidelijk heb kunnen uitleggen.

Dirk H.

Dirk H. schreef: ↑

08 okt 2020 05:14

jkpieterse schreef: ↑

07 okt 2020 20:51

Kan je laten zien wat je al hebt en aangeven wat er niet werkt?

Beste,

alvast bedankt voor uw reactie.
hier wat ik reeds geprobeerd heb.

Sub Slicers()

Dim lTel As Long
Dim lCol As Long
Dim sGro As String
Dim sSeg As String
Dim sLov As String
Dim Myrange as range

lTel = 2
Do Until Cells(lTel, 1) = ""
lTel = lTel + 1
Loop
lTel = lTel - 1
lCol = 7
Do Until Cells(1, lCol) = ""
lCol = lCol + 1
Loop

Set Myrange = Range(Cells(2, 1), Cells(lTel, lCol))
Myrange.Select

ActiveSheet.ListObjects.Add(xlSrcRange, Myrange, , xlYes).Name = _
"Tabel3"
Range("Tabel3[[#Headers],[Art Nr]]").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "_Lev Code" _
).Slicers.Add ActiveSheet, , "_Lev Code", "_Lev Code", 22.5, 81, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "Schap"). _
Slicers.Add ActiveSheet, , "Schap", "Schap", 60, 118.5, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
"Artikel Groep").Slicers.Add ActiveSheet, , "Artikel Groep", "Artikel Groep", _
97.5, 156, 144, 198.75

lCol = 7
Do Until Cells(2, lCol) = ""
sGro = Cells(2, lCol)
sSeg = Cells(2, lCol + 1)
sLov = Cells(2, lCol + 2)

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sGro). _
Slicers.Add ActiveSheet, , sGro, sGro, 135, 193.5, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sSeg). _
Slicers.Add ActiveSheet, , sSeg, sSeg, 172.5, 231, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
sLov).Slicers.Add ActiveSheet, , sLov, _
sLov, 210, 268.5, 144, 198.75
lCol = lCol + 5
Loop


End Sub

De bedoeling is om telkens 3 slicers te creeëren in een blok van 5 kolommen. De eerste 3 in het voorbeeld zijn basiskolommen die vast staan. (deze staan in de eerste 6 kolommen van het werkblad). Vanaf kolom 7 heb ik blokken van 5 kolommen en wil ik de eerste 3 van elk blok met een slicer voorzien. (het aantal blokken van 5 kolommen kan variëren van 1 tot 10 blokken).

Hoop dat ik het een beetje duidelijk heb kunnen uitleggen.

Dirk H.

Goedemorgen,

Vanmorgen heb ik nogmaals met deze macro (is een deel van een ander macro) een nieuw document bewerkt en als wonder bij wonder heeft het zonder fout gewerkt.
ik moet nu nog enkel de locatie van de slicers aanpassen naargelang de positie van de kolommen.
kan dit ook met een variabele?

Dirk H.

Toch bedankt voor de reactie

Als het goed is is het eerste getal in je code op de regels die een slicer toevoegen de "Left" eigenschap van de slicer, de positie vanaf links. Als je die getallen vervangt door Cells(2, lCol).Left, dan zou het moeten werken, zoiets als dit:

Beste JKPieterse,

vanuit jouw tip heb ik verder gezocht naar de oplossing.

Dit is een correct werkende Macro.
hiermee komen de 3 vaste slicers en de 3 slicers in de blokken van 5 kolommen telekens op de juiste plaats terecht. zie bijlage.
Sub Slicers()

Dim lTel As Long
Dim lCol As Long
Dim sGro As String
Dim sSeg As String
Dim sLov As String
Dim Myrange As Range
Dim lLe As Long
Dim lTo As Long
Dim lWi As Long
Dim lHe As Long

lTel = 2
Do Until Cells(lTel, 1) = ""
lTel = lTel + 1
Loop
lTel = lTel - 1
lCol = 1
Do Until Cells(2, lCol) = ""
lCol = lCol + 1
Loop
lCol = lCol - 1
Set Myrange = Range(Cells(2, 1), Cells(lTel, lCol))
Myrange.Select

ActiveSheet.ListObjects.Add(xlSrcRange, Myrange, , xlYes).Name = _
"Tabel3"
ActiveSheet.Range("Tabel3[#All]").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("Tabel3[[#Headers],[Art Nr]]").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "_Lev Code" _
).Slicers.Add ActiveSheet, , "_Lev Code", "_Lev Code", 390, 300, 90, 198.75
ActiveSheet.Shapes.Range(Array("_Lev Code")).Select

ActiveSheet.Shapes("_Lev Code").LockAspectRatio = msoTrue
Selection.PrintObject = msoFalse
Application.CommandBars("Format Object").Visible = False

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), "Schap"). _
Slicers.Add ActiveSheet, , "Schap", "Schap", 390, 391, 144, 198.75
ActiveSheet.Shapes.Range(Array("Schap")).Select
ActiveSheet.Shapes("Schap").LockAspectRatio = msoTrue
Selection.PrintObject = msoFalse
Application.CommandBars("Format Object").Visible = False

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
"Artikel Groep").Slicers.Add ActiveSheet, , "Artikel Groep", "Artikel Groep", _
390, 536.5, 90, 198.75

ActiveSheet.Shapes.Range(Array("Artikel Groep")).Select
ActiveSheet.Shapes("Artikel Groep").LockAspectRatio = msoTrue
Selection.PrintObject = msoFalse
Application.CommandBars("Format Object").Visible = False
Cells(1, 1).Select
lCol = 7
lTo = 390
lLe = 715
lHe = 198.75

Do Until Cells(2, lCol) = ""
sGro = Cells(2, lCol)
sSeg = Cells(2, lCol + 1)
sLov = Cells(2, lCol + 2)
lWi = 80
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sGro). _
Slicers.Add ActiveSheet, , sGro, sGro, 390, lLe, lWi, 198.75
lLe = lLe + lWi + 1
lWi = 85
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sSeg). _
Slicers.Add ActiveSheet, , sSeg, sSeg, 390, lLe, lWi, 198.75
lLe = lLe + lWi + 1
lWi = 120
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
sLov).Slicers.Add ActiveSheet, , sLov, _
sLov, 390, lLe, lWi, 198.75

lLe = lLe + lWi + 45
lCol = lCol + 5
Loop

End Sub

Bedankt voor de tip!

Groeten
Dirk H.