Invoegen selectieevakje

[PeterBijns]

Beste allemaal,
ik heb een bestand waarin 8 kolommen zitten elke kolom heeft 100 regels met een datum. Voor elke kolom staat een kolom met lege cellen (eigenlijk heb ik dus 16 kolommen) in die kolom met lege cellen wil ik steeds een selectie vakje plaatsen welke gekoppeld is aan die cel waarin hij geplaatst wordt. In de aan het selectie vakje gekoppelde cel komt dan WAAR of ONWAAR te staan indien ik een vinkje plaats.

Het plaatsen van de selectie vakjes en het koppelen aan de cel is een hels karwij en ik vraag mij af of het met VBA gedaan kan worden.

Er wordt geen tekst bij het selectie vakje geplaatst dus alleen het vakje zelf moet erin komen te saan.

Welke knappe kop heeft voor mij de oplossing?

Alvast bedankt voor een oplossing.

Groet, Peter

 

[JeanPaul28]

Selectie door dubbelklik in cel met vba code, zou een oplossing kunnen zijn

 

[PeterBijns]

Dank voor je antwoord JeanPaul,
Maar ik ben op zoek naar de VBA code welke bij een dubbelklik in de cel een selectie vakje plaatst.
Groet, Peter

 

[JeanPaul28]

Peter welkom op het forum
Gewoonlijk vragen we van de topicstarters een fictief excel voorbeeld bestand, dit is duidelijker dan 1000 woorden

 

[edmoor]

Maar ik ben op zoek naar de VBA code welke bij een dubbelklik in de cel een selectie vakje plaatst.

Een selectievakje staat aan of uit, True of False.
Waarom dan speciaal een selectievakje.
Het kan ook een vink tekentje uit het Wingdings font zijn.

 

[gast0660]

Hoi Peter,
Welkom op het forum
Bedoel je zoiets?

Sub dotch()
Dim Rng As Range, WorkRng As Range
Dim Ws As Worksheet
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Ws = Application.ActiveSheet
Application.ScreenUpdating = False
For Each Rng In WorkRng
    With Ws.CheckBoxes.Add(Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        .Characters.Text = Rng.Value
    End With
Next
WorkRng.ClearContents
Application.ScreenUpdating = True
End Sub

 

[edmoor]

Dubbelklik eens op A1:
Bekijk bijlage Vinkje.xlsm

 

[VenA]

Gefeliciteerd met het exact tienjarige lidmaatschap. Omdat het jouw 'verjaardag'is zelf maar even een bestandje gemaakt dan kan je zien wat @JeanPaul28 bedoelt. Dubbelklik ergens in kolom A en je ziet het wel.

Kan blijkbaar even geen bestandje uploaden met een macro. Even de celeigeinschappen in kolom A op Windings 2 zetten.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 1 Then
    Cancel = -1
    Cells(Target.Row, 1) = IIf(Target = "R", "£", "R")
    Cells(Target.Row, 1).Offset(, 1) = Target = "R"
  End If
End Sub

 

[VenA]

@edmoor, ongeveer dezelfde gedachte

 

[edmoor]

Yep!

 

[VenA]

Ik kreeg geen bestandje bijgevoegd en was daarmee aan het prutsen en blijkbaar jouw reactie gemist. (Maar eens even kijken of het plaatsen van een bestand aan Chrome of helpmij ligt)

 

[PeterBijns]

Hallo allemaal,
gast0660 heeft voor mij de mooiste oplossing de VBA plaatst een selectie vakje, maar de macro vraagt steeds een bevestiging van de geselecteerde cel welke je moet bevestigen en het selectie vakje wordt niet gelijk aan de geselecteerde cel toegewezen en actief gezet.
Maar het neemt veel tijd en geklik weg dus ik ben erg blij mee.

Ik dank iedereen voor de bijdrage.

Groet, Peter
ps. volgende keer zal ik een voorbeeld bestand uploaden

 

[gast0660]

Peter,

bevestiging van de geselecteerde cel

Je kan ook meerdere cellen ineens selecteren.

 

[PeterBijns]

Hoi gast0660, wederom dank voor je prachtige oplossing.
Het is mooi dat ik ook meerdere cellen kan selecteren om de selectie vakjes te plaatsen en het zou dan nog helemaal super zijn als heet selectie vakje gelijk gekoppeld zou worden aan de cel waarin hij geplaatst wordt en dat het selectie vakje op actief wordt gezet.

Maar wat de macro nu doet vind ik ook al super...!!

Mijn dank is groots en eeuwig durend.

Groet, Peter

 

[gast0660]

Hoi Peter,
U vraagt, wij draaien.

Sub dotch()
Dim c As Range, wr As Range, cb As CheckBox
Set wr = Application.Selection
Set wr = Application.InputBox("Range", xTitleId, wr.Address, Type:=8)
Application.ScreenUpdating = False
For Each c In wr
    Set cb = c.Worksheet.CheckBoxes.Add(c.Left, c.Top, c.Width, c.Height)
    cb.Text = vbNullString
    cb.LinkedCell = c.Address(0, 0)
Next
    wr.NumberFormat = ";;;"
    wr = True
Application.ScreenUpdating = True
End Sub

 

[PeterBijns]

Super bedankt gast0660 wat een prachtige oplossing ik ben er erg blij mee.
je verdiend een lintje.

Groet, Peter

 

[gast0660]

Dank voor de terugkoppeling:thumb:
Suc6

 

[HSV]

Niets ten nadele van de zoektocht.
Je kan zien dat 'option explicit' niet gebruikt wordt en daarmee de code van het internet is gehaald.

 

[gast0660]

@ HSV
De code komt uit een van mijn excel kastjes en veel van de codestukjes komen inderdaad van het internet, maar wat is het probleem, ik heb niet de behoefte om iedere dag opnieuw het wiel uit te vinden en Peter is er mee geholpen.
*knip*

 

[HSV]

@gast0660,

Ik wilde testen of je mails van Helpmij.nl nog steeds in je spam-map terecht komen.
Misschien moet je even naar je eigen gestelde vragen kijken (28 augustus 2018) en nog even een reactie geven op de laatste twee reacties.

Dat je je niet afvraagt waaraan ik kan zien dat je de code niet zelf hebt geschreven (mijn haantjesgedrag).
Ook ik weet niet alles uit mijn hoofd en grijp regelmatig terug op mijn verzameling, maar de stukken die er niet in horen zijn er dan op z'n minst uitgehaald.

Dat je mij gelijk als een dronkaard beschuldigd vind ik wel erg laag.
Als dat zo was dan had ik een dik uur later in onderstaande link de vraag vast niet zo kunnen beantwoorden (nee, niet uit mijn kastje).
https://www.helpmij.nl/forum/showthread.php/942398-Automatisch-doornummeren-excel


Ps, ik was jaloers dat je er een lintje voor verdiende.

Gegroet.