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.
Slicers in een exceldocument invoegen via VBA code
-
- Site Admin
- Berichten: 806
- Lid geworden op: 30 jan 2017 14:32
Re: Slicers in een exceldocument invoegen via VBA code
Kan je laten zien wat je al hebt en aangeven wat er niet werkt?
Re: Slicers in een exceldocument invoegen via VBA code
Beste,jkpieterse schreef: ↑07 okt 2020 20:51Kan je laten zien wat je al hebt en aangeven wat er niet werkt?
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.
Re: Slicers in een exceldocument invoegen via VBA code
Goedemorgen,Dirk H. schreef: ↑08 okt 2020 05:14Beste,jkpieterse schreef: ↑07 okt 2020 20:51Kan je laten zien wat je al hebt en aangeven wat er niet werkt?
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.
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
-
- Site Admin
- Berichten: 806
- Lid geworden op: 30 jan 2017 14:32
Re: Slicers in een exceldocument invoegen via VBA code
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:
Code: Selecteer alles
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sGro). _
Slicers.Add ActiveSheet, , sGro, sGro, Cells(2, lCol).Left, 193.5, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), sSeg). _
Slicers.Add ActiveSheet, , sSeg, sSeg, Cells(2, lCol).Left + 37.5, 231, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Tabel3"), _
sLov).Slicers.Add ActiveSheet, , sLov, _
sLov, Cells(2, lCol).Left + 75, 268.5, 144, 198.75
Re: Slicers in een exceldocument invoegen via VBA code
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.
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.
- Bijlagen
-
- transfer.JPG (511.58 KiB) 450 keer bekeken