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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
| Public Cellules2 As Range, Cellules3 As Range
Private Sub dgfreg()
Dim Plage As Range
Dim recup As String
Dim Plage1 As String
With Worksheets("Feuil1")
For Each Cellules3 In Worksheets("Feuil1").Range("J4:j" & .Range("j" & .Rows.Count).End(xlUp).Row)
'-------------si frere et soeur veulent des photos individuelles et une photo famille--------------------------------
Set Plage = Nothing
Plage1 = ""
For Each Cellules2 In Worksheets("Feuil1").Range("B4:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
If Cellules3 = Cellules2 And Cellules2(1, 3).Value = "F" And Cellules2(1, 4).Value = "1" And Cellules2(1, 5).Value = "1" Then
If Plage Is Nothing Then
Set Plage = Union(Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Cellules2(1, 2).Value
Else
Set Plage = Union(Plage, Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Plage1 & "," & Cellules2(1, 2).Value
End If
recup = Cellules2.Value
End If
Next Cellules2
If Not Plage Is Nothing Then
MsgBox "la famille : " & recup & " des photos individuelles et une photo de famille pour " & Plage1 & ".", vbOKCancel
End If
'----------------------si frere et soeur veulent une photo de famille------------------------------------
Set Plage = Nothing
For Each Cellules2 In Worksheets("Feuil1").Range("B4:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
If Cellules2 = Cellules3 And Cellules2(1, 3).Value = "F" And Cellules2(1, 4).Value = "0" And Cellules2(1, 5).Value = "1" Then
If Plage Is Nothing Then
Set Plage = Union(Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Else
Set Plage = Union(Plage, Cellules2, Cellules2(1, 2), Cellules2(1, 3))
End If
recup = Cellules2.Value
End If
Next Cellules2
If Not Plage Is Nothing Then
MsgBox "la famille : " & recup & " veut seulement une photo de famille"
End If
'----------------------si frere et soeur veulent une photo individuelle------------------------------------
Set Plage = Nothing
Plage1 = ""
For Each Cellules2 In Worksheets("Feuil1").Range("B4:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
If Cellules2 = Cellules3 And Cellules2(1, 3).Value = "F" And Cellules2(1, 4).Value = "1" And Cellules2(1, 5).Value = "0" Then
If Plage Is Nothing Then
Set Plage = Union(Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Cellules2(1, 2).Value
Else
Set Plage = Union(Plage, Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Plage1 & "," & Cellules2(1, 2).Value
End If
recup = Cellules2.Value
End If
Next Cellules2
If Not Plage Is Nothing Then
MsgBox "la famille : " & recup & " veut seulement des photos individuelles de " & Plage1
End If
'---------------------------------si enfant veut une photo individuelle----------------------------------
Set Plage = Nothing
Plage1 = ""
For Each Cellules2 In Worksheets("Feuil1").Range("B4:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
If Cellules2 = Cellules3 And Cellules2(1, 3).Value = "n" And Cellules2(1, 4).Value = "1" Then
If Plage Is Nothing Then
Set Plage = Union(Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Cellules2(1, 2).Value
Else
Set Plage = Union(Plage, Cellules2, Cellules2(1, 2), Cellules2(1, 3))
Plage1 = Plage1 & "," & Cellules2(1, 2).Value
End If
recup = Cellules2.Value
End If
Next Cellules2
If Not Plage Is Nothing Then
MsgBox "l'enfant : " & recup & " " & Plage1 & " veut une photo individuelle."
End If
Next Cellules3
End With
Set Cellules2 = Nothing
Set Cellules3 = Nothing
End Sub |
Partager