Case à cocher ajoutée automatiquement mais qui ne se place pas au bon endroit

RomaneK

XLDnaute Nouveau
Bonjour à toute la communauté,

J'ai rajouté un bout de code dans ma macro qui me permet d'ajouter une case à cocher dans la colonne T (sur la même ligne qu'une cellule non vide en K ou plutôt dans mon cas sur la première ligne copiée, celle quio contient le numéro de palette en colonne K) et fait de telle manière à ce que la cellule liée soit sur la même case que la check box mais sur une autre feuille. La macro est attribuée à un command button.
L'ajout fonctionne, la cellule liée est au bon endroit mais la checkbox est sans cesse créée au même endroit et je ne sais pas ce qui pose problème dans mon code (la partie en question est mise en gras) :

VB:
Sub PaletteN_Cliquer()

Application.ScreenUpdating = False

Dim NumPal As Integer
Dim c As Range
Dim DernLgn As Integer
Dim Prems
Dim co As Integer
Dim cel As Range
Dim i As Integer
i = 1

'La variable Numpal est volontairement stockée sur une feuille de gestion (cf. (1))
'et vaut N & N° de la dernière ligne non vide à partir de la cellule L1 (dans la feuille "Mise_en_preparation" + 1
NumPal = Range("Gestion_CAC!N" & Range("Mise_en_preparation!L1").End(xlDown).Row) + 1
   
'Pour chaque cellule dans la plage "Gestion_CAC" de I35 à I246
    For Each c In Range("Gestion_CAC!i35:i246")
    'DernLgn = N° de la dernière ligne non vide à partir de la cellule L1 + 1
    DernLgn = Range("Mise_en_preparation!L1").End(xlDown).Row + 1
        'Si la valeur de la cellule est une erreur (type #N/A), passe la ligne à vérifier donc passe la boucle
        If IsError(c.Value) Then GoTo JePasse
        'Si la valeur de la cellule est "VRAI" alors
        If c = True Then
                'Si i = 1 alors
                If i = 1 Then
                    'La cellule K & N° de la dernière ligne non vide à partir de la cellule L1 + 1 Soit la première ligne copiée = Numéro de palette
                    Range("Mise_en_preparation!K" & DernLgn) = NumPal
                            'Mise en forme
                            With Range(cells(DernLgn, 12), cells(DernLgn, 14)).Borders(xlEdgeLeft)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                            With Range(cells(DernLgn, 12), cells(DernLgn, 14)).Borders(xlEdgeTop)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                            With Range(cells(DernLgn, 12), cells(DernLgn, 14)).Borders(xlEdgeRight)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                            For co = 15 To 20
                                    With cells(DernLgn, co).Borders(xlEdgeLeft)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                    End With
                                    With cells(DernLgn, co).Borders(xlEdgeTop)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                    End With 
                                    With cells(DernLgn, co).Borders(xlEdgeRight)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                    End With 
                             Next
                            
                            [B]'Ajouter un case à cocher dans les cellules sélectionnées
 
                            With Range("Mise_en_preparation!T" & DernLgn)
 
                                ActiveSheet.CheckBoxes.Add(2409.75, 135, 29.25, 41.25).Select
 
                            End With
 
                                
 
                            With Selection
 
                             Sheets("Gestion_CAC").Activate
 
                            'Lier la case d'à côté pour les cellules sélectionnées
 
                            .LinkedCell = "Gestion_CAC!V" & DernLgn
 
                            .Characters.Text = ""
 
                            End With
 
                            Sheets("Mise_en_preparation").Activate[/B]
                               
                            
                           
                End If
           
            'Le code a besoin de récupérer la valeur de la ligne de dessus pour incrémenter le numéro de palette donc celui-ci est stockée
            'dans la feuille "Gestion_CAC", colonne N, puis récupérée pour l'incrémentation (1)
            Range("Gestion_CAC!N" & DernLgn) = NumPal
           
            'Sytème de copie: Les lignes de la colonne C, si sélectionnées (si Gestion_CAC!c =VRAI)sont copiées dans la colonne L sur la première cellule non vide
            Range("Mise_en_preparation!L" & DernLgn) = Range("Mise_en_preparation!C" & c.Row - 32)
                           
            'Sytème de copie: Les lignes de la colonne D, si sélectionnées (si Gestion_CAC!c =VRAI)sont copiées dans la colonne M sur la première cellule non vide
            Range("Mise_en_preparation!M" & DernLgn) = Range("Mise_en_preparation!D" & c.Row - 32)
           
            'Sytème de copie: Les lignes de la colonne E, si sélectionnées (si Gestion_CAC!c =VRAI)sont copiées dans la colonne N sur la première cellule non vide
            Range("Mise_en_preparation!N" & DernLgn) = Range("Mise_en_preparation!E" & c.Row - 32)
           
                            'Mise en forme
                             With Range(cells(DernLgn, 12), cells(DernLgn, 14)).Borders(xlEdgeLeft)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                   
                            With Range(cells(DernLgn, 12), cells(DernLgn, 14)).Borders(xlEdgeRight)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                                                                
                            For co = 15 To 20
                               
                                With cells(DernLgn, co).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                               
                                With cells(DernLgn, co).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                            Next
        
         'La cellule qui était VRAI passe à #N/A ce qui passe la case à cocher en "Mixité" (=case noire)
         c.Value = "#N/A"
         
         'incrémente la valeur de i
         i = i + 1
        End If
JePasse:
    Next
                           'Mise en forme
                           With Range(cells(DernLgn, 12), cells(DernLgn, 20)).Borders(xlEdgeTop)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                       
                              'Prems = N° de la dernière ligne non vide à partir de la cellule K1
                              'Prems = Range("Mise_en_preparation!K1").End(xlDown).Row
 
                Sheets("feuil1").Range("C4").Value = "Mise_en_preparation!"" N° ""& NumPal &""]"")"
              
End Sub
Si c'est possible de trouver sans que jenvoie le fichier, mon entreprise ne mautorise pas tellement à le transmettre... (je peux faire des copies d'écran sinon)

Merci d'avance !!
 

RomaneK

XLDnaute Nouveau
Partie du code à modifier selon moi mais quoi je ne trouve pas...

VB:
'Ajouter un case à cocher dans les cellules sélectionnées

                            With Range("Mise_en_preparation!T" & DernLgn)
                                ActiveSheet.CheckBoxes.Add(2409.75, 135, 29.25, 41.25).Select
                            End With
                              
                            With Selection
                             Sheets("Gestion_CAC").Activate
                            'Lier la case d'à côté pour les cellules sélectionnées

                            .LinkedCell = "Gestion_CAC!V" & DernLgn
                            .Characters.Text = ""
                            End With
 

RomaneK

XLDnaute Nouveau
https://www.mrexcel.com/forum/excel...-how-move-chart-shape-based-cell-referen.html

"Add(2409.75, 135, 29.25, 41.25)" les deux premières coordonnées représente la position de la checkbox sur la feuille en fonction de l'unité par défaut. Le lien ci-dessus montre qu'on peut les remplacer par une cellule cible: exemple :
VB:
Add(Range("Mise_en_preparation!T" & DernLgn).Left, Range("Mise_en_preparation!T" & DernLgn).Top, 29.25, 41.25)

Ecrire : Range("....") .Left ou . Top
 

cathodique

XLDnaute Barbatruc
à tester
VB:
Option Explicit

Sub Inserer_Cases_a_cocher_Liees()
    Dim rngCel As Range
    Dim ChkBx As CheckBox

    For Each rngCel In Selection
        With rngCel.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel.Address Then
                .NumberFormat = ";;;"
                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                With ChkBx
                    'valeur initiale :
                    .Value = xlOff    'pourrait être True ou False
                    'cellule liée
                    .LinkedCell = rngCel.MergeArea.Cells.Address
                End With
            End If
        End With
    Next rngCel
End Sub
 

Discussions similaires

Réponses
8
Affichages
708