dit, hieronder, stond er in de meegeleverde bijlage van #6, evenwel met niet zoveel commentaar als hieronder.
Dit is jouw opgenomen macro, maar opnemen heeft de neiging om ongebreideld uitgebreid en omslachtig met veel select's en activate's te zijn.
Dat kan je met een kleine inspanning veel leesbaarder en door de bijgeleverde commentaar begrijpbaarder maken.
Je moest dus enkel nog je huidige "macro1" vervangen door onderstaande en dan die "Macro1" onder 1 van je knoppen hangen.
Sub Macro1()
shps 'even die macro uitvoeren
Range("N1").Value = 1 'waarde 1 zetten in N1
Range("N1").Copy 'die waarde kopieren
With Columns("I:I") 'in kolom I
.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False 'vermenigvuldigen met de waarden aldaar
.RemoveDuplicates Columns:=1, Header:=xlNo 'verwijder de dubbelen in die kolom (zonder header)
'splits in kolommen op basis van een tab (????? komt dit wel voor ?)
.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="0", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End With
Application.CutCopyMode = False
ActiveWorkbook.Save 'bestand opslaan
End Sub
Sub shps()
For Each shp In ActiveSheet.Shapes
'MsgBox shp.TopLeftCell.Address & vbTab & shp.Type 'zeg per shape de cel linksboven en het type
Select Case shp.Type 'onderscheid maken in het type
Case 8, 12 '2 soorten knoppen
Case Else 'al de rest
shp.Delete 'verwijderen
End Select
Next
End Sub