Probleme cellule liée checkbox

Version imprimable

Bonjour le forum,

J'ai une macro qui crée automatiquement des checkbox comme je le veux.
J'ai un probleme avec les cellules liées à ces checkbox, celles qui renvoient la valeur VRAI, FAUX, je n'arrive pas à les placer là ou je le veux.
Voila mon code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub AjouteCheckBox()
    Dim Box As CheckBox
    Dim Cpt As Integer, LigDeb As Integer, LigFin As Integer, LigLiee As Integer
    Dim ColonneBox As String, ColLiee As String, ColDeb As String, ColFin As String
 
    LigDeb = 13
    LigFin = 29
    ColDeb = 4
    ColFin = 10
ColLiee = "L"
 
    Application.ScreenUpdating = False
    With ActiveSheet
 
   For Col = ColDeb To ColFin
        For Cpt = LigDeb To LigFin
            If .Rows(Cpt).RowHeight < 13.5 Then
                .Rows(Cpt).RowHeight = 13.5
            End If
 
Set Box = .CheckBoxes.Add((.Cells(Cpt, Col).Left + (.Cells(Cpt, Col).Width) / 2) - 8.25, .Cells(Cpt, Col).Top - 1, 0, 0)
 
            With Box
                .Name = "CheckBoxCol" & Col & "Lig" & Format(Cpt, "000")
                .Height = 16.5
                .Width = 16.5
                .Characters.Text = ""
                .LinkedCell = ColLiee & Cpt
            End With
            Cpt = Cpt + 3
 
        Next Cpt
 
    Next Col
 
    End With
    Application.ScreenUpdating = True
End Sub

Tout se joue sur la ligne .LinkedCell.
Pour l'instant toutes les checkbox situées sur la même ligne sont reliées à la même cellule.
J'aimerais que chaque checkbox soit liées à la cellule qui est directement en dessous d'elle, mais voila je n'y arrive pas.

Merci pour votre aide

Bonjour,
Sans avoir testé... essaye

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Dim ADD as string
ADD = (.Cells(Cpt, Col).Left + (.Cells(Cpt, Col).Width) / 2) - 8.25, .Cells(Cpt, Col).address
 
Set Box = .CheckBoxes.Add(Range(ADD),Top - 1, 0, 0)
 
            With Box
                .Name = "CheckBoxCol" & Col & "Lig" & Format(Cpt, "000")
                .Height = 16.5
                .Width = 16.5
                .Characters.Text = ""
                .LinkedCell = ADD
            End With

Ou au moins quelque chose dans le genre.
Y a peut-être des erreur de parenthèses. :oops:
A+

19/08/2009, 15h30
altra

Re et merci pour la réponse

Sur cette ligne il y une erreur de syntaxe

Code:

ADD = (.Cells(Cpt, Col).Left + (.Cells(Cpt, Col).Width) / 2) - 8.25 , .Cells(Cpt, Col)

sur la virgule apres le 8.25.

J'ai mis un & mais peut etre que ça change le sens.

puis apres la macro stoppe sur la ligne suivante

Code:

Set Box = .CheckBoxes.ADD(Range(ADD).Top - 1, 0, 0)

La méthode Range de l'objet global a échoué.

Puis je ne comprends pas ton code. ADD prend la valeur d'un chiffre, donc Linkedcell ne comprendra?

Peux tu m'éclairer

Merci bcp

C'est bon, grace au code de LeForestier j'ai trouvé.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub AjouteCheckBox()
    Dim Box As CheckBox
    Dim Cpt As Integer, LigDeb As Integer, LigFin As Integer, LigLiee As Integer
    Dim ColonneBox As String, ColLiee As String, ColDeb As String, ColFin As String
 
 
    LigDeb = 13
    LigFin = 29
    ColDeb = 4
    ColFin = 10
 
 
    Application.ScreenUpdating = False
    With ActiveSheet
 
   For Col = ColDeb To ColFin
        For Cpt = LigDeb To LigFin
            If .Rows(Cpt).RowHeight < 13.5 Then
                .Rows(Cpt).RowHeight = 13.5
            End If
 
LigLiee = Cpt + 1
LIG = .Cells(LigLiee, Col).Address
 
Set Box = .CheckBoxes.ADD((.Cells(Cpt, Col).Left + (.Cells(Cpt, Col).Width) / 2) - 8.25, .Cells(Cpt, Col).Top - 1, 0, 0)
 
            With Box
                .Name = "CheckBoxCol" & Col & "Lig" & Format(Cpt, "000")
                .Height = 16.5
                .Width = 16.5
                .Characters.Text = ""
                .LinkedCell = LIG
            End With
            Cpt = Cpt + 3
 
        Next Cpt
 
    Next Col
 
    End With
    Application.ScreenUpdating = True
End Sub

Donc j'ai rajouté ces 2 lignes et tout marche

Code:

1
2
LigLiee = Cpt + 1
LIG = .Cells(LigLiee, Col).Address

Merci bcp et bonne journée à tous

19/08/2009, 15h40
LeForestier

Autant pour moi, je me suis un peu :mrgreen: mélanger les pinceaux.
Change juste cette ligne..

Code:

.LinkedCell = Cells(Cpt + 1, Col).Address.

A+
Edit : ajouter +1 suite à ton poste que je n'avais pas encore vu.
19/08/2009, 15h45
altra

Oui c'est plus court. Merci à toi