Cases à cocher
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
Bonjour
Pour trouver une solution tes 2 fichiers sont indispensables
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
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
Bonjour
Modifie la ligne correspondante
wbkc.ActiveSheet.Cells(fin1, 1) = CDate(aa(i, 1))