Bonjour
Y a quelques semaines de ca, (avec bcp d'aide venant de ce forum) j'ai pu réalisé une macro qui faisait ce que je voulais comme je le voulais.
Seulement, maintenant que je veut la mettre en place pour qu'elle soit utilisée, elle met un temps fou à s'executer! Je n'est pourtant pas modifié grand chose (quelque noms, et numeros de cellules), et avant mes deux semaines de vacances il me semblait qu'elle éarchait normalement.
Je met le code si dessous, dans l'espoir que je vous puissiez reperer une coquille qui la ralentirais (car même sur une feuille vide, son éxécution met 30 à 40sec!)
Y a quelques semaines de ca, (avec bcp d'aide venant de ce forum) j'ai pu réalisé une macro qui faisait ce que je voulais comme je le voulais.
Seulement, maintenant que je veut la mettre en place pour qu'elle soit utilisée, elle met un temps fou à s'executer! Je n'est pourtant pas modifié grand chose (quelque noms, et numeros de cellules), et avant mes deux semaines de vacances il me semblait qu'elle éarchait normalement.
Je met le code si dessous, dans l'espoir que je vous puissiez reperer une coquille qui la ralentirais (car même sur une feuille vide, son éxécution met 30 à 40sec!)
Code:
Private Sub CommandButton1_Click()
Dim Cell As Range
Dim flag As Boolean
Dim myarray(15) As String
feuille = ActiveSheet.Name
Application.ScreenUpdating = False
For n = 8 To Range("B65536").End(xlUp).Row Step 2
If n = 14 Then n = 15
If n = 23 Then n = 26
If n = 30 Then n = 31
If n = 41 Then n = 42
Workbooks.Open "G:\chemin d'acces\fiche remplacement vierge.xls"
Workbooks("2007team1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)
i = 6
For Each Cell In plage_date
If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
Application.ScreenUpdating = True
Application.Calculation = xlManual
If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = True
flag = True
i = i + 1
nom = Range("B" & n)
prenom = Range("B" & n + 1)
heure = Cell.Value
jour = Cells(6, Cell.Column)
Application.ScreenUpdating = False
Select Case feuille
Case "JAN"
mois = "Janvier"
....
Case "DEZ"
mois = "Décembre"
End Select
Workbooks("fiche remplacement vierge.xls").Worksheets("sheet1").Range("G3") = mois
Workbooks("fiche remplacement vierge.xls").Worksheets("sheet1").Cells(i, 2) = heure
Workbooks("fiche remplacement vierge.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("fiche remplacement vierge.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("fiche remplacement vierge.xls").Worksheets("sheet1").Cells(i, 6) = poste
If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = False
End If
Next Cell
If flag Then
Workbooks("fiche remplacement vierge.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
Workbooks("fiche remplacement vierge.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
Workbooks("fiche remplacement vierge.xls").Sheets("sheet1").Range("E30") = "Fait le " & Date
Workbooks("fiche remplacement vierge.xls").Sheets("sheet1").Range("E30").Font.Bold = True
Filename = "remplacement " & mois & " " & nom & ".xls"
Workbooks("fiche remplacement vierge.xls").SaveAs "C:\Documents and Settings\" & Application.UserName & "\My Documents\Remplacement" & Filename
myarray(j) = Filename
j = j + 1
End If
flag = False
Next n
Workbooks("fiche remplacement vierge.xls").Close
Application.EnableEvents = True
reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
j = 0
Do Until myarray(j) = ""
Workbooks(myarray(j)).PrintOut
j = j + 1
Loop
End If
Line1:
Application.Calculation = xlAutomatic
End Sub
