Discussion :

[alexandrek]

Bonjour,

Voila ma problèmatique :

Dans ma feuille principale (BOOK), Jai donc des transactions listées dans un tableau qui commence à la ligne 26.

Lors d'un click droit sur la souris sur une de ces lignes colonne D, j'utilise les différentes valeurs contenu sur cette ligne et je les réorganise de façon à renseigner un "Billet" dont la structure est représentée dans la feuille REF.

Je voudrais savoir comment améliorer ce code afin que si je sélectionne plusieurs cellules à l'aide de la manipulation (Contrôle click) (à partir de la ligne 26 colonne D) renseigner les billets un après l'autre ??
Est ce possible ??

Voici le code de départ :

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
 
Option Explicit
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
'Si plusieurs cellules selectionnées, on quitte
If Target.Count > 1 Then Exit Sub
 
'Si la cellule selectionné ne se trouve pas dans le tableau, on quitte
If Target.Column < 4 Then Exit Sub
If Target.Column > 4 Then Exit Sub
If Target.Row < 26 Then Exit Sub
 
message = MsgBox("Do you want book Ticket?", vbOKCancel + vbQuestion, "Booking Program")
If message = 2 Then Exit Sub
 
 
With Sheets("BOOK")
 
Call crea_page
 
    'On veut renseigner la cellule C4,D4 de la feuille "Nom"
    'Celle-ci doit contenir le Deal Slip de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    Sheets(nom).Range("C4:D4").Value = .Cells(Target.Row, "D").Value
 
    ' On veut renseigner la  cellule C6,D6 de la feuille "Nom
    ' Celle-ci doit contenir la contrepartie de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    Sheets(nom).Range("C6:D6").Value = .Cells(Target.Row, "A").Value
 
    ' On veut renseigner la  cellule C7,D7 de la feuille "Nom
    ' Celle-ci doit contenir le type d'opération  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
   ' Sheets(nom).Range("C7:D7").Value = .Cells(Target.Row, "E").Value
 
    ' On veut renseigner la  cellule C8,D8 de la feuille "Nom
    ' Celle-ci doit contenir la date de settlement  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    Sheets(nom).Range("C8:D8").Value = .Cells(Target.Row, "F").Value
 
    ' On veut renseigner la  cellule D11 ou D12 de la feuille "Nom"
    ' Celle-ci doit contenir le montant acheté  ou le montant vendu de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    ' Si montant en colone G supérieur à 0 alors on achéte et intégré cellule D1 sinon cellule D12
    If .Cells(Target.Row, "G").Value > 0 Then
        Sheets(nom).Range("D11").Value = .Cells(Target.Row, "G").Value
        Range("D11").Value = Range("D11").NumberFormat = "0.00"
    Else
        Sheets(nom).Range("D11").Value = .Cells(Target.Row, "H").Value
        Range("D11").Value = Range("D11").NumberFormat = "0.00"
    End If
 
 
    ' On veut renseigner la  cellule D12 de la feuille "Nom
    ' Celle-ci doit contenir le montant vendu  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    If .Cells(Target.Row, "H").Value < 0 Then
        Sheets(nom).Range("D12").Value = .Cells(Target.Row, "H").Value
        Range("D12").Value = Range("D12").NumberFormat = "0.00"
    Else
        Sheets(nom).Range("D12").Value = .Cells(Target.Row, "G").Value
        Range("D12").Value = Range("D12").NumberFormat = "0.00"
        End If
 
 
    ' On veut renseigner la  cellule C11 et C12  de la feuille "Nom"
    ' Celle-ci doit contenir la devise achetée ou la devise vendue  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    ' Si G > 0 alors K est ds C11
    ' Si G < 0 alors K est ds C12
    If .Cells(Target.Row, "G").Value > 0 Then
        Sheets(nom).Range("C11").Value = .Cells(Target.Row, "K").Value
    Else
        Sheets(nom).Range("C11").Value = .Cells(Target.Row, "L").Value
    End If
 
    ' On veut renseigner la  cellule C12 de la feuille "Nom
    ' Celle-ci doit contenir la devise vendue  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    If .Cells(Target.Row, "H").Value < 0 Then
        Sheets(nom).Range("C12").Value = .Cells(Target.Row, "L").Value
    Else
        Sheets(nom).Range("C12").Value = .Cells(Target.Row, "K").Value
    End If
 
    ' On veut renseigner la  cellule C13,D13 de la feuille "Nom"
    ' Celle-ci doit contenir le taux  de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    Sheets(nom).Range("C13:D13").Value = .Cells(Target.Row, "M").Value
 
    ' On veut renseigner la  cellule C9,D9 de la feuille "Nom"
    ' Celle-ci doit contenir la paire de devise de la ligne sur laquelle on a clicker sur la feuille "BOOK"
    Sheets(nom).Range("C9:D9").Value = .Cells(Target.Row, "K").Value & "/" & .Cells(Target.Row, "L").Value

Merci beaucoup pour votre aide

[Philippe Tulliez]

Bonjour,
Pour parcourir la Selection

Code :

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

1
2
3
4
5
6
7
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Dim cel As Range
  For Each cel In Target
   MsgBox cel
  Next
End Sub

[alexandrek]

Merci

mais cette procédure va me permettre de parcourir toutes les sélections. Dans le cas de ma procédure

Je précise d'avantage, puis je répéter cette procédure si je fais un controle click et je sélectione d'autres cellules ...

j'utilise les différentes valeurs contenues sur cette ligne et je les réorganise de façon à renseigner un "Billet" et faire de même si j'ai sélectionné une autre cellule... (à l'aide d'un controle click )

Même si j'enlève ma première phrase de code

Code :

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

1
2
 
If Target.Count > 1 Then Exit Sub

et que je rajoute votre code cela ne marche pas vraiment

[Philippe Tulliez]

Bonjour,
Je t'ai donnée une piste.
Tu places ton code dans la boucle que je t'ai fournie

Code :

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

1
2
3
4
5
6
7
8
9
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Dim cel As Range
  For Each cel In Target
   ' MsgBox cel
   ' *** ici ton code ***
 
  Next
End Sub

Par exemple

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim cel As Range
 For Each cel In Target 
   'Si plusieurs cellules selectionnées, on quitte
   If Target.Count > 1 Then Exit Sub
 
   'Si la cellule selectionné ne se trouve pas dans le tableau, on quitte
    If Target.Column < 4 Then Exit Sub
    If Target.Column > 4 Then Exit Sub
    If Target.Row < 26 Then Exit Sub
   ' etc ........
Next

Mais attention la ligne de ton code que j'ai mis en gras et souligné est en contradiction avec ta nouvelle demande puisque Target.count sera supérieur à 1 si tu sélectionnes plusieurs cellules.

[alexandrek]

Merci oui j'avais mis en commentaire cette condition ...
(Si plusieurs cellules selectionnées exit sub)

En faite, cela marche mais le problème vient du fait de cette partie de mon code qui lui va créer une page pour la cellule sélectionnée en Colonne D et va porter comme nom le contenu de la cellule activée.( la sub crea_page est appelée au tout début afin de ranger ensuite les données dans cette nouvelle feuille (Sheet(Nom))

donc si je fais un contrôle click pour en sélectioner une autre en meme temps il comprends plus ... car pour lui la page existe déja donc il sort de la sub etant donnée que cette page portera le nom de la cellule sélectionnée,
comment faire pour que la page suivante porte le nom des autres cellules sélectionées ?


je vous montre le code je pense que c'est de la que vient l'erreur

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 crea_page()
'
'
'   Création nouvelle page avec le numero du deal
 
Set MaFeuille = ActiveSheet
 
nom = ActiveCell.Value
 
 
'On verifie que le nom n'existe pas déjà
On Error Resume Next 'en cas d'erreur, on continu sans generer d'erreur
Set MaNewFeuille = Sheets(nom)
On Error GoTo 0 'on réactive la gestion d'erreur
'On verifie si la variable a obtenu un objet ou non
 
'messagebox ' Si elle existe déjà Msg soit annule ou remplace
If Not MaNewFeuille Is Nothing Then
message = MsgBox("Ticket is booked", vbOKCancel + vbQuestion, "Booking Program")
If message = 2 Then Exit Sub
End If
 
'Sinon on continu
'Add retourne un objet Worksheet, qu'on recupere dans MaNewFeuille
Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
'Renome la nouvelle feuille
MaNewFeuille.Name = nom

[mercatog]

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
57
58
59
60
61
62
63
64
65
66
67
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, Plage As Range
Dim LastLig As Long
 
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
Application.ScreenUpdating = False
   For Each c In Plage
      If Trim(c.Value) <> "" Then
         If MsgBox("Do you want book Ticket for " & c.Value & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
            Call Crea_Page(c)
            With Sheets("BOOK")
               Sheets(c.Value).Range("C4:D4").Value = .Cells(c.Row, "D").Value
               Sheets(c.Value).Range("C6:D6").Value = .Cells(c.Row, "A").Value
               Sheets(c.Value).Range("C8:D8").Value = .Cells(c.Row, "F").Value
               If .Cells(c.Row, "G").Value > 0 Then
                  Sheets(c.Value).Range("D11").Value = .Cells(c.Row, "G").Value
                  Range("D11").Value = Range("D11").NumberFormat = "0.00"
               Else
                  Sheets(c.Value).Range("D11").Value = .Cells(c.Row, "H").Value
                  Range("D11").Value = Range("D11").NumberFormat = "0.00"
               End If
               If .Cells(c.Row, "H").Value < 0 Then
                  Sheets(c.Value).Range("D12").Value = .Cells(c.Row, "H").Value
                  Range("D12").Value = Range("D12").NumberFormat = "0.00"
               Else
                  Sheets(c.Value).Range("D12").Value = .Cells(c.Row, "G").Value
                  Range("D12").Value = Range("D12").NumberFormat = "0.00"
               End If
               If .Cells(c.Row, "G").Value > 0 Then
                  Sheets(c.Value).Range("C11").Value = .Cells(c.Row, "K").Value
               Else
                  Sheets(c.Value).Range("C11").Value = .Cells(c.Row, "L").Value
               End If
               If .Cells(Target.Row, "H").Value < 0 Then
                  Sheets(c.Value).Range("C12").Value = .Cells(c.Row, "L").Value
               Else
                  Sheets(c.Value).Range("C12").Value = .Cells(c.Row, "K").Value
               End If
               Sheets(c.Value).Range("C13:D13").Value = .Cells(c.Row, "M").Value
               Sheets(c.Value).Range("C9:D9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
               .Activate
            End With
         End If
      End If
   Next c
End If
Set Plage = Nothing
End Sub
 
Sub Crea_Page(Rng As Range)
Dim MaFeuille As Worksheet
Dim Nom As String
 
Nom = Rng.Value
On Error Resume Next
Set MaFeuille = Sheets(Nom)
On Error GoTo 0
If MaFeuille Is Nothing Then
   Set MaFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
   MaFeuille.Name = Nom
Else
   MsgBox "Ticket is booked", vbOKOnly + vbQuestion, "Booking Program"
End If
End Sub

[alexandrek]

Je me suis penché sur ce code, je l'ai analyser et surtout essayer de le comprendre .... une chose que je comprends pas ...


Pour répondre au premier message box "Do you want book ticket for " & c.value & "?"

En cliquant sur OK, cela génére un message d'erreur me disant "incompatibilité de type" et en cliquant sur fin il me génére le premier billet sans ces infos (mais pas les autres sélectionnés)

Tandis que si je clique sur annuler il me demande si je veux booker la 2ème cellule sélectionnée (avec le contrôle plus click) et à nouveau me renvoie ce message d'erreur.

(En cliquant sur fin il le génére tout de meme mais sans les infos, en cliquant sur annuler il me demande si je veux booker le 3ie et il se passe la même chose que pour les 2iers)

En faite, ce message d'erreur empêche la macro de continuer pour les autres cellules sélectionnées et s'arrête sur cette ligne

Code :

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

1
2
 
Sheets(c.Value).Range("C4:D4").Value = .Cells(c.Row, "D").Value

++

[mercatog]

Tu peux joindre un extrait de ton fichier pour test?

[mercatog]

à cause du type des données de ta colonne D
J'ai modifié tes codes pour que ça donne le résultat escompté
1.

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
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, Plage As Range
Dim LastLig As Long
Dim Sh As Worksheet
 
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
   Application.ScreenUpdating = False
   For Each c In Plage
      If Trim(c.Value) <> "" Then
         If MsgBox("Do you want book Ticket for " & CStr(Format(c.Value, "00000")) & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
            Call Crea_Page(c)
            Set Sh = Sheets(CStr(Format(c.Value, "00000")))
            With Sheets("BOOK")
               Sh.Range("C4:D4").Value = c.Value
               Sh.Range("C6:D6").Value = .Cells(c.Row, "A").Value
               Sh.Range("C8:D8").Value = .Cells(c.Row, "F").Value
               If .Cells(c.Row, "G").Value > 0 Then
                  Sh.Range("D11").Value = .Cells(c.Row, "G").Value
                  Sh.Range("D11").NumberFormat = "0.00"
               Else
                  Sh.Range("D11").Value = .Cells(c.Row, "H").Value
                  Sh.Range("D11").NumberFormat = "0.00"
               End If
               If .Cells(c.Row, "H").Value < 0 Then
                  Sh.Range("D12").Value = .Cells(c.Row, "H").Value
                  Sh.Range("D12").NumberFormat = "0.00"
               Else
                  Sh.Range("D12").Value = .Cells(c.Row, "G").Value
                  Sh.Range("D12").NumberFormat = "0.00"
               End If
               If .Cells(c.Row, "G").Value > 0 Then
                  Sh.Range("C11").Value = .Cells(c.Row, "K").Value
               Else
                  Sh.Range("C11").Value = .Cells(c.Row, "L").Value
               End If
               If .Cells(Target.Row, "H").Value < 0 Then
                  Sh.Range("C12").Value = .Cells(c.Row, "L").Value
               Else
                  Sh.Range("C12").Value = .Cells(c.Row, "K").Value
               End If
               Sh.Range("C13:D13").Value = .Cells(c.Row, "M").Value
               Sh.Range("C9:D9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
               .Activate
            End With
         End If
      End If
   Next c
End If
Set Plage = Nothing
End Sub

2.

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
 Option Explicit ' pour obliger a declarer toutes tes variables
Sub Crea_Page(Rng As Range)
Dim MaFeuille As Worksheet
Dim Nom As String
 
Nom = Format(CStr(Rng.Value), "00000")
On Error Resume Next
Set MaFeuille = Sheets(Nom)
On Error GoTo 0
If MaFeuille Is Nothing Then
   Set MaFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
   MaFeuille.Name = Nom
   With MaFeuille
      Sheets("REF").Range("A1:E17").Copy MaFeuille.Range("A1")
      .Columns("B:B").ColumnWidth = 20.29
      .Columns("C:C").ColumnWidth = 15#
      .Columns("D:D").ColumnWidth = 15.43
      .Rows("3:3").RowHeight = 20.25
      .Rows("4:16").RowHeight = 15.75
      .Range("C4:D4").ClearContents
      .Range("C6:D8").ClearContents
      .Range("C10:D13").ClearContents
      With .Range("C13:D13").Font
         .Bold = True
         .Italic = True
      End With
   End With
Else
   MsgBox "Ticket " & Nom & " is booked", vbOKOnly + vbQuestion, "Booking Program"
End If
Set MaFeuille = Nothing
End Sub

[alexandrek]

Ah oui le contenu des cellules en colone D est des nombres ....

Franchement je vous remercie énormément et toutes les personnes du forum ...

j'apprends vraiment beaucoup au travers des conseils que j'ai sur ce site

c'est un réel plaisir d'être membre...

cordialement

et si je peux faire quelque chose même vous inviter à boire un verre n'hésitez pas

c est la moindre des politesses

[mercatog]

L'étape suivante est de nettoyer un peux le code
1.

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
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, Plage As Range
Dim LastLig As Long
Dim Sh As Worksheet
 
Cancel = True
LastLig = Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = Intersect(Target, Range("D27:D" & LastLig))
If Not Plage Is Nothing Then
   Application.ScreenUpdating = False
   For Each c In Plage
      If Trim(c.Value) <> "" Then
         If MsgBox("Do you want book Ticket for " & CStr(Format(c.Value, "00000")) & "?", vbOKCancel + vbQuestion, "Booking Program") = vbOK Then
            Call Crea_Page(c)
            Set Sh = Sheets(CStr(Format(c.Value, "00000")))
            With Sheets("BOOK")
               Sh.Range("C4").Value = c.Value
               Sh.Range("C6").Value = .Cells(c.Row, "A").Value
               Sh.Range("C8").Value = .Cells(c.Row, "F").Value
               Sh.Range("C9").Value = .Cells(c.Row, "K").Value & "/" & .Cells(c.Row, "L").Value
               If .Cells(c.Row, "G").Value > 0 Then
                  Sh.Range("C11").Value = .Cells(c.Row, "K").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "L").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "G").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "H").Value
               Else
                  Sh.Range("C11").Value = .Cells(c.Row, "L").Value
                  Sh.Range("C12").Value = .Cells(c.Row, "K").Value
                  Sh.Range("D11").Value = .Cells(c.Row, "H").Value
                  Sh.Range("D12").Value = .Cells(c.Row, "G").Value
               End If
               Sh.Range("D11:D12").NumberFormat = "0.00"
               Sh.Range("C13").Value = .Cells(c.Row, "M").Value
               .Activate
            End With
            Set Sh = Nothing
         End If
      End If
   Next c
End If
Set Plage = Nothing
End Sub

2.

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
Sub Crea_Page(Rng As Range)
Dim MaFeuille As Worksheet
Dim Nom As String
 
Nom = Format(CStr(Rng.Value), "00000")
On Error Resume Next
Set MaFeuille = Sheets(Nom)
On Error GoTo 0
If MaFeuille Is Nothing Then
   Set MaFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
   MaFeuille.Name = Nom
   With MaFeuille
      Sheets("REF").Range("A1:E17").Copy MaFeuille.Range("A1")
      .Columns("B:B").ColumnWidth = 20.29
      .Columns("C:D").ColumnWidth = 15.43
      .Rows("3:3").RowHeight = 20.25
      .Rows("4:16").RowHeight = 15.75
      .Range("C4:D4,C6:D8,C10:D13").ClearContents
   End With
Else
   MsgBox "Ticket " & Nom & " is booked", vbOKOnly + vbQuestion, "Booking Program"
End If
Set MaFeuille = Nothing
End Sub

[alexandrek]

Bonjour,

Voila après tout ces actions, je voudrais envoyer par mail

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
      Sh.Select
      ActiveWorkbook.EnvelopeVisible = True
 
   With ActiveSheet.MailEnvelope
      .Introduction = "Please you will found below the ticket Number" & c.Value
      .Item.To = "ADDRESSE MAIL "
      .Item.Subject = "Ticket Number " & c.Value
      .Item.body = "Regards"
      .Item.Send
   End With

Le problème que je rencontre c est que j'ai bien toutes les données ds le mail avec le mail tout prêt à l'envoi.
Cependant, non seulement il m'envoie pas le mail automatiquement comme demandé mais quand je clique sur envoie, j'ai un message indiquant qu'il il y a une boite de dialogue ouverte dans microsoft outlook et il me demande de fermer cette boite.

je comprends pas trop pourquoi il se passe cela ?

merci d'avance