Sub auto_open()
'
' ouvrir_fichiers Macro
' Macro enregistrée le 30/10/2010 par krys
'
Dim i As Long
Dim fichier_synthese, fichier_mois_N, fichier_mois_N1 As String
'
fichier_synthese = ActiveWorkbook.Name
'désactivation des calculs auto
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
'-------------
'Ouverture du mois N
'-------------
Workbooks.Open(Filename:=Sheets("ListOnglets").Range("B2")).RunAutoMacros Which:=xlAutoOpen
fichier_mois_N = ActiveWorkbook.Name
Workbooks(fichier_synthese).Activate
Sheets("ListOnglets").Select
Range("B4").Select
Do
Selection.ClearContents
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
Range("B4").Select
For i = 1 To Workbooks(fichier_mois_N).Worksheets.Count
ActiveCell.Offset(i - 1, 0).Value = "[" & Range("B3") & "]" & Workbooks(fichier_mois_N).Sheets(i).Name & "'"
Next i
'-------------
'Ouverture du mois N+1
'-------------
Workbooks.Open(Filename:=Sheets("ListOnglets").Range("C2")).RunAutoMacros Which:=xlAutoOpen
fichier_mois_N1 = ActiveWorkbook.Name
Workbooks(fichier_synthese).Activate
Sheets("ListOnglets").Select
Range("C4").Select
Do
Selection.ClearContents
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
Range("C4").Select
For i = 1 To Workbooks(fichier_mois_N1).Worksheets.Count
ActiveCell.Offset(i - 1, 0).Value = "[" & Range("C3") & "]" & Workbooks(fichier_mois_N1).Sheets(i).Name & "'"
Next i
'----------------
'Mise à jour des calculs 'bleus'
'----------------
Range("P3").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Mois_N1&""!$A$8:$A$25""),RC1,INDIRECT(""'""&Mois_N1&""!$AG$8:$AG$25"")))+SUMPRODUCT(SUMIF(INDIRECT(""'""&Mois_N1&""!$A$8:$A$25""),RC1&"" HN"",INDIRECT(""'""&Mois_N1&""!$AG$8:$AG$25"")))*2"
Range("Q3").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Mois_N&""!$A$8:$A$25""),RC1,INDIRECT(""'""&Mois_N&""!$AG$8:$AG$25"")))+SUMPRODUCT(SUMIF(INDIRECT(""'""&Mois_N&""!$A$8:$A$25""),RC1&"" HN"",INDIRECT(""'""&Mois_N&""!$AG$8:$AG$25"")))*2"
Range("P3:Q3").Select
Selection.Copy
Selection.End(xlDown).Select
Range("P3:Q" & ActiveCell.Row).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'--------
'Fermeture des fichiers pointage
'---------
Workbooks(fichier_mois_N).Close
Workbooks(fichier_mois_N1).Close
'ré-activation des calculs auto
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
End Sub