feuille = ActiveSheet.Name
For n = 9 To Range("B65536").End(xlUp).Row Step 3
If n = 30 Then n = 33
Workbooks.Open "c:\Documents And Settings\diaquint\My Documents\rpl.xls"
Workbooks("2007Schicht2modif1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)
Application.ScreenUpdating = True
i = 6
For Each Cell In plage_date
If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
Application.ScreenUpdating = True
[COLOR="Red"]If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = True[/COLOR]
flag = True
'Application.ScreenUpdating = False
i = i + 1
nom = Range("B" & n)
prenom = Range("B" & n + 1)
Workbooks("rpl.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
Workbooks("rpl.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
Workbooks("rpl.xls").Sheets("sheet1").Range("E28") = "Fait le " & Date
Workbooks("rpl.xls").Sheets("sheet1").Range("E28").Font.Bold = True
heure = Cell.Value
jour = Cells(6, Cell.column)
Select Case feuille
....
End Select
Workbooks("rpl.xls").Worksheets("sheet1").Range("G3") = mois
With Workbooks("rpl.xls").Worksheets("sheet1").Range("G3").Font
.Bold = False
.Italic = False
.Underline = False
End With
Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 2) = heure
Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 4) = jour & " " & mois
remplace = InputBox("Entrez le nom de la personne remplacée le " & jour & " " & mois & " par " & prenom & " " & nom, "Remplacement", lastname, 9960, 330)
Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 5) = remplace
lastname = remplace
If Cell.Interior.ColorIndex = 38 Then
poste = "Neutra"
Else
poste = InputBox("Entrez le poste", "Remplacement", lastposte, 9960, 330)
lastposte = poste
End If
Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 6) = poste
'explication = InputBox("Entrez les explications du remplacement", "Remplacement", "", 9960, 330)
'Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 7) = explication
If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = False
End If
Next Cell
If flag Then
Workbooks("rpl.xls").Activate
Workbooks("rpl.xls").SaveAs Filename:="remplacement " & mois & " " & nom
End If
flag = False
Next n
Workbooks("2007Schicht2modif1.xls").Activate
Application.ScreenUpdating = True
Workbooks("rpl.xls").Close
reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
If reponse = 7 Then
End If
End If
End Sub