Discussion :

[nicodvn]

J'ai un problème que je n'arrive pas à résoudre et c'est avec une petite bouille tristounette que je viens vous voir. :

PIECE JOINTE A LA FIN

J'ai crée une feuille prestataire avec par exemple:
Traiteur (case a cocher)
Photographe (case à cocher)
Serveur (case à cocher)
....

Je voudrai que lorsque je coche une case, son libellé (ex: traiteur) se rajoute sur la feuille devis.
Cela me permet ainsi de plus vite rajouter tous les prestataires dans mon devis juste en cochant la case associée. Il faudrait par contre que dans le devis tous les prestataire se mettent à la suite (mais si dans la feuille prestataire je ne coche pas tous les prestataires à la suite)


presta devis.xlsx



Je cherche mais je n'ai pas trouvé pour faire ca. Avec cette solution je pourrai en plus résoudre d'autres probllèmes que j'ai.

J'espere que vous pourrez m'aider.

Merci et bonne soirée à tous.

Nicolas

[eric4459]

Bonjour Nicodvn,
J'ai un peu modifié ton fichier et remplacer les Case à cocher par des CheckBox.
En mode édition j'ai sélectionné les case à cocher dans la partie Control ActiveX, ces contrôles permettent de leur associé une cellule de ta feuille qui prendra la valeur vrai ou faux selon qu'elle sera cochée ou non (en mode création: clic droit sur le bouton et choisir "Propriétés --> affecter la cellule désirée sur la ligne LinckedCell, ici respectivement C4, C5, C6, C7)
Toujours en mode création, clic droit sur le bouton et choisir "Visualiser le code", le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Private Sub CheckBox1_Click()
End Sub

sera créé sur la feuille où se trouve le bouton.
Dans ce code il faut ajouter le nom de la macro qui fera le !copier/coller", ici Création_Devis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub CheckBox1_Click()
Création_Devis
End Sub

Dans un module j'ai créé le code suivant qui sera appelé à chaque fois qu'une case est cochée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
Sub Création_Devis()
Dim Prest As Worksheet
Dim Devis As Worksheet
Dim Pr As Range
Dim Dev As Range
Dim i As Integer
Dim j As Integer
Set Prest = ThisWorkbook.Sheets("PRESTATAIRES")
Set Devis = ThisWorkbook.Sheets("DEVIS")
Set Pr = Prest.Range("C4")
Set Dev = Devis.Range("A5")
Pr = Pr.Offset(0)
Dev = Dev.Offset(0)
i = 0
j = 0
 
Do While Pr.Offset(i, -2) <> ""
    If Pr.Offset(i, 0) = True Then
      Dev.Offset(j, 0).Value = Pr.Offset(i, -2).Value
    End If
    i = i + 1
        If Dev.Offset(j, 0) = "" Then
        j = j
        Else
        j = j + 1
        End If
Loop
 
Devis.Select
Dev.Offset(0, 0).Select
ActiveSheet.Range("$A$4:$C$8").RemoveDuplicates Columns:=1
Range("A5:C18").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
    End With
Prest.Select
 
End Sub

J'ai également créé un autre code pour vider l'onglet devis si désiré qui se lancera après avoir cliqué sur un bouton mis sur la page PRESTATAIRES

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Remise_a_Zéro()
Dim Dev As Range
Dim Pr As Range
Set Prest = ThisWorkbook.Sheets("PRESTATAIRES")
Set Devis = ThisWorkbook.Sheets("DEVIS")
Set Pr = Prest.Range("C4")
Set Dev = Devis.Range("A5")
Pr = Pr.Offset(0)
Dev = Dev.Offset(0)
 
 Application.ScreenUpdating = False
 
Devis.Select
Dev.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection = ""
Dev.Offset(0, 0).Select
Prest.CheckBox1.Value = False
Prest.CheckBox2.Value = False
Prest.CheckBox3.Value = False
Prest.CheckBox4.Value = False
Prest.Select
Pr.Offset(0, -2).Select
 
Application.ScreenUpdating = True
 
 
End Sub

Tu pourras bien sur ajouter d'autre cases pour d'autres professions en ajoutant à chaque fois un nouveau code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub CheckBox(Numéro de la CheckBox)_Click()
Création_Devis
End Sub

et en ajoutant

Prest.CheckBox(Numéro de la CheckBox).Value = False

dans la procédure "Remise_a_Zéro"

J'espère ne pas avoir été trop confus.
Eric

[nicodvn]

Merci beaucoup Eric. Tu as été très clair et je vais donc essayer de l'appliquer.
Encore merciiii pour le temps que t me consacres

Quand je coche la case cela fait bien apparaître le texte sur le devis. Mais j'aurai souhaité que si je décoche ce dernier disparaisse sur la feuille devis.
Le bouton effacer va mettre utile pour tout nettoyer d'un coup.

Autre petit soucis que je ne comprend pas. Quand je coche la case, le temps d'une seconde, apparaît le tableau devis en fond.

Merci beaucoup Eric. J’espère ne pas déranger en demandant votre aide.

[eric4459]

Bonjour Nicolas,
Il faudrait que tu jette un coup d'oeil sur les codes afin de chercher à les comprendre et les reproduire si nécessaire.

Sinon, pour l'apparition de la feuille Devis c'est normal puisque la macro fait des "aller-retour" entre les deux feuilles.
Pour éviter cela il faut mettre en début de code l'instruction

Application.ScreenUpdating = False

et en fin de code

Application.ScreenUpdating =True

, chose que j'avais oubliée.

Sinon j'ai modifié le code pour les boutons, voici celui du premier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Création_Devis
Else
Decoche_Case
End If
End Sub

et le code "Decoche_Case" associé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Decoche_Case()
Dim Devis As Worksheet
Dim Dev As Range
Dim i As Integer
Set Devis = ThisWorkbook.Sheets("DEVIS")
Set Dev = Devis.Range("A5")
Dev = Dev.Offset(0)
i = 0
 If Dev.Offset(i, 0) <> "" Then
 Dev.Offset(i, 0) = ""
 End If
 
End Sub

A l'attention du Forum
Toute remarque et autres conseils sur ces codes sont bienvenus, cela permettra de nous améliorer.

Eric