Cases à cocher

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
a_loic
Membre habitué
Membre habitué
Messages : 100
Inscrit le : 16 janvier 2015
Version d'Excel : 2016

Message par a_loic » 25 janvier 2016, 15:30

Bonjour,

Et bonne année à tous et toues :)

Voilà mon problème :

J'ai un tableau Excel avec une macro qui me permet d'importer dans un tableau les données provenant d'un fichier extérieur.
Cette macro ajoute des données sur les colonnes A à F.
Les données peuvent être plus ou moins importante (nombre de lignes aléatoires en fonction des journées traitées)

Je cherche à ajouter à droite de ces données des cases à cocher "oui" et "non" qui sont reliées à la case dans laquelle elles se trouvent.
"Oui" en colonne G
"Non" en colonne H
Pour se faire, j'ai trouvé une macro sur le net que j'ai bêtement intégré à la macro existante :
Option Explicit

Sub Import()
    Dim Fichier As String, fd As Object, nom$, wbks As Workbook, fin&, aa, i&, wbkc As Workbook, fin1&
    Set fd = Application.FileDialog(1)
    Set wbkc = ThisWorkbook
    fin1 = wbkc.ActiveSheet.Cells.Find("*", , xlValues, , 1, 2, 0).Row + 1
    With fd
        Fichier = ThisWorkbook.Path
        .Title = "Choisissez le fichier 'changement de prix' extrait de BackStore"
        .InitialFileName = Fichier '& "\*"
        .ButtonName = "Importer"
        .Filters.Clear
        '.Filters.Add "Fichier Excel", "*.xls"
        .AllowMultiSelect = False
        If .Show <> 0 Then
            nom = .SelectedItems(1)
            Set wbks = Workbooks.Open(nom)
            fin = wbks.ActiveSheet.Cells.Find("*", , xlValues, , 1, 2, 0).Row
            aa = wbks.ActiveSheet.Range("B27:AV" & fin)
            Application.ScreenUpdating = 0
            wbks.Close 0
            For i = 1 To UBound(aa)
                If aa(i, UBound(aa, 2)) Like "*Virtual Cashier*" Then
                    wbkc.ActiveSheet.Cells(fin1, 1) = aa(i, 1)
                    wbkc.ActiveSheet.Cells(fin1, 2) = aa(i, 5)
                    wbkc.ActiveSheet.Cells(fin1, 3) = aa(i, 10)
                    wbkc.ActiveSheet.Cells(fin1, 4) = aa(i, 15)
                    wbkc.ActiveSheet.Cells(fin1, 5) = aa(i, 33)
                    fin1 = fin1 + 1
                End If
            Next i
            wbkc.ActiveSheet.Range("A7:H" & fin1 - 1).Borders.LineStyle = 1
            wbkc.ActiveSheet.Columns("A:E").HorizontalAlignment = xlCenter
            
            Dim rngCel As Range
            Dim ChkBx As CheckBox
            wbkc.ActiveSheet.Range("G7:G" & fin1 - 1).Select
            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
        'Texte de remplacement
        '.Characters.Text = "TITI"
        'texte
        .Text = "Oui" ' ou : .Caption = "Toto"
        'bordure :
        With .Border
          'Style de ligne
          '.LineStyle = xlLineStyleNone 'ou xlContinuous 'ou xlDashDot ou xlDashDotDot ou xlDot
          'couleur
          '.ColorIndex = 3  '3 = rouge
          'épaisseur du trait
          '.Weight = 4
        End With
        'accessibles aussi les propriétés .Locked, .Name, .Enabled etc...
      End With
    End If
  End With
Next rngCel

            wbkc.ActiveSheet.Range("H7:H" & fin1 - 1).Select
            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
        'Texte de remplacement
        '.Characters.Text = "TITI"
        'texte
        .Text = "Non" ' ou : .Caption = "Toto"
        'bordure :
        With .Border
          'Style de ligne
          '.LineStyle = xlLineStyleNone 'ou xlContinuous 'ou xlDashDot ou xlDashDotDot ou xlDot
          'couleur
          '.ColorIndex = 3  '3 = rouge
          'épaisseur du trait
          '.Weight = 4
        End With
        'accessibles aussi les propriétés .Locked, .Name, .Enabled etc...
      End With
    End If
  End With
Next rngCel

        Else
            MsgBox "Vous n'avez sélectionné aucun fichier dans votre dossier", , "Manque de Sélection": GoTo 1
        End If
    End With
1
End Sub
Le résultat est horrible à lire et en plus deux problèmes se posent :

1. j'ai un débogage parce que la macro a l'air reliée à un autre doc (mais je ne vois pas où modifier ça)
2. les cases à cocher se cumulent sur les lignes déjà occupées... En gros si hier j'ai eu 2 lignes, j'ai des cases à cocher sur G7 et G8 et sur H7 et H8. Ce matin, ca me remettra, par dessus, des cases à cocher sur ces cellules au lieu de continuer en dessous...


J'espère avoir été clair :s

Merci d'avance pour votre aide

Excellente journée,

Loïc
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 25 janvier 2016, 16:10

Bonjour

Pour trouver une solution tes 2 fichiers sont indispensables

:joindre: :joindre:
a
a_loic
Membre habitué
Membre habitué
Messages : 100
Inscrit le : 16 janvier 2015
Version d'Excel : 2016

Message par a_loic » 25 janvier 2016, 16:31

Re :)


Veuillez trouver ci joint les fameux fichiers. (A savoir que j'ai mis le fichier principal avec la macro qui fonctionne pour vous permettre de visualiser le résultat (sans les cases à cocher))

J'ai mis :
- "exemple_extraction.xls" qui correspond au fichier contenant les données qui s'ajoutent au fichier principal
- "Exemple1.xlsm" qui est le fichier principal dans lequel les données s'insèrent et contenant la macro

Pour info, dans le fichier "Exemple1.xlsm", la colonne F "Numéro collaborateur" est saisie manuellement. En colonne G et H doivent apparaitre les cases à cocher.

Enfin, j'ai découvert un autre problème, le format date est inversé alors que la cellule a l'air bien paramétrée...

Excellent journée,

Merci d'avance,

Loïc
exemple_extraction.xls
fichier contenant les données qui s'ajoutent au fichier principal
(46.5 Kio) Téléchargé 26 fois
Exemple1.xlsm
fichier principal dans lequel les données s'insèrent
(19.7 Kio) Téléchargé 31 fois
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 25 janvier 2016, 17:04

Bonjour

A tester
a_loic Case à cocher V001.xlsm
(27.19 Kio) Téléchargé 40 fois
a
a_loic
Membre habitué
Membre habitué
Messages : 100
Inscrit le : 16 janvier 2015
Version d'Excel : 2016

Message par a_loic » 25 janvier 2016, 18:57

Re :)

Merci infiniment pour la rapidité !

J'ai une dernière chose, il y a toujours ce bug qui se produit sur le format de la date. Le jour et le mois sont inversés alors que c'est ok sur le fichier de base et dans le format de la cellule d'accueil.

Merci encore,

Bonne soirée,

Loïc
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 25 janvier 2016, 19:17

Bonjour

Modifie la ligne correspondante
wbkc.ActiveSheet.Cells(fin1, 1) = [surligner]CDate(aa(i, 1))[/surligner]
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message