checkbox kopieren en gekoppelde cel wijzigen

[Joete]

Ben al 2 dagen aan het zoeken naar een oplossing die ik niet kan vinden, dus tijd om de vraag hier maar te stellen...

In mijn excel document kopieer ik een regel met in die regel een checkbox die gekoppeld (linkedcell) zit aan een cel in die regel.
De regel bevat wat data, de checkbox (formulier element volgens mij) bepaalt of de regel afgedrukt moet worden of niet (de gelinkte cell bevat een true/false waar ik in een andere macro op controleer). De checkbox is dus gewoon aan en uit te vinken, maar gaat ook automatisch aan en uit wanneer een cel in de rij gevuld of geleegd wordt.
Doordat bij het kopieren de gekoppelde cel blijft staan op wat ie was kan ik de nieuwe regel niet aan/uitvinken om wel/niet af te drukken.

Een warrig verhaal misschien, maar waar het op neer komt is het volgende:

• Ik kopieer een regel (bv. regel 33)
• Ik voeg de gekopieerde regel onderaan in (bv. regel 41)
• De checkbox van de gekopieerde regel wordt bij het kopieren / plakken overgenomen
• De gekoppelde cel blijft op de cel staan van de gekopieerde regel (checkbox zichtbaar in regel 41, reageert op cel in regel 33)

Ik moet dus de gekoppelde cel (LinkedCell) wijzigen, dat op zich is geen probleem, maar hoe bereik ik net die ene checkbox die ik er net ingeplakt heb? Ik weet geen naam van de checkbox, die naam (los misschien van het kunnen wijzigen?) vindt ik verder ook niet interessant. Ik loop hier behoorlijk in vast...

Code tot nu toe:

    ' algemeen
    Dim Zoek As String
    Dim ZoekRij As Long
    Dim ZoekRij2 As Long
    Dim ZoekCB As Shape
    
    ' verdieping toevoegen bij verdiepingshoogte
    Zoek = "Verdiepingshoogte (gemiddeld)"
    ZoekRij = Application.WorksheetFunction.Match(Zoek, Range("C:C"), 0)
    On Error GoTo 0
    ZoekRij2 = Sheets("Voorblad").Range("E" & ZoekRij + 1).End(xlDown).Row
    Rows(ZoekRij2).EntireRow.Copy
    Rows(ZoekRij2 + 1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    With Sheets("Voorblad").Range(ZoekRij2 + 1 & ":" & ZoekRij2 + 1)
        For Each ZoekCB In .Shapes
            .Value = xlOff
            .LinkedCell = Cells(ZoekRij2 + 1, 15)
            .Display3DShading = False
        Next ZoekCB
    End With

Bij de "For" krijg ik nu steeds de foutmelding (438 "Deze eigenschap of methode wordt niet ondersteund door dit object").

Misschien nog goed om te melden: de checkbox staat dus optisch in de range, de linkedcell staat op de regel er boven, maar daar kan ik niet naar zoeken, omdat daar ook een checkbox staat en die moet blijven staan zoals die is...

Wie o wie kan mij helpen?
Alvast bedankt.

 

[HSV]

Maak gebruik van 'Topleftcell'.

 

[snb]

gebruik het font wingdings ter vervanging van vinkvakken.

 

[Joete]

Maak gebruik van 'Topleftcell'.

Thanks! Dat was het zetje wat ik nodig had. Nog wel ff een uurtje aan het prutsen geweest om het allemaal goed te krijgen, maar het werkt!

    ' algemeen
    Dim Zoek As String
    Dim ZoekRij As Long
    Dim ZoekRij2 As Long
    Dim ZoekCB As Shape
    Dim cbRij As Long
    Dim cbKol As Long
    Dim cbNaam As String
    
    ' verdieping toevoegen bij verdiepingshoogte
    Zoek = "Verdiepingshoogte (gemiddeld)"
    ZoekRij = Application.WorksheetFunction.Match(Zoek, Range("C:C"), 0)
    On Error GoTo 0
    ZoekRij2 = Sheets("Voorblad").Range("E" & ZoekRij + 1).End(xlDown).Row
    Rows(ZoekRij2).EntireRow.Copy
    Rows(ZoekRij2 + 1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    
    For Each ZoekCB In Sheets("Voorblad").Shapes
        cbRij = ZoekCB.TopLeftCell.Row
        cbKol = ZoekCB.TopLeftCell.Column
        If cbRij = ZoekRij2 + 1 And cbKol = 15 Then
            cbNaam = ZoekCB.Name
            With Sheets("Voorblad").Shapes(cbNaam).OLEFormat.Object
                .LinkedCell = "Voorblad!$O" & ZoekRij2 + 1 & "" 'Cells(ZoekRij2 + 1, 15)
            End With
        End If
    Next ZoekCB

Me happy!!! :thumb: