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
|
' Génération des fichiers CA Prévisionnel 2011 par Agence
'le 17/11/2010 JBV
' A voir : tps d'exécution trop lent = +/- 20s / agence => a optimiser
Sub Export_CA_PREVISIONNEL()
Dim agence As String
Dim CheminFicExport As String
Application.Cursor = xlWait 'Affiche le sablier
Application.ScreenUpdating = False 'Désactivation du raffraichissement écran
Application.DisplayAlerts = False 'Désactivation des messages d'alertes et les questions
'--Application.Calculation = xlCalculationManual 'Désactivation du calcul automatique
'Boucle sur les agences
For Each MonAgence In Range("ListeAgence")
If (Sheets("Menu").Cells(MonAgence.Row, 10).Value = "ok") Then
agence = MonAgence.Text
CheminFicExport = Sheets("Menu").Cells(MonAgence.Row, 9).Value
Range("NUM_AGENCE") = agence 'Maj du code agence onglet synthèse CA
'-- Traitement et alimentation des onglets --------------------------------------
Run "BOUCLE_CT"
Run "BOUCLE_CA_LOYER"
Run "BOUCLE_CA_GLOBAL"
'Run "MAJ_DATA3"
'-- Sauvegarde du classeur pour l'Agence en --------------------------------------
Sheets(Array("Descriptif", "CA prévsionnel 2012", "Contrats en cours", "Nouveaux contrats", "Prévisionnel PARC", "CA N-1", "Paramètres")).Select
Cells.Select
Sheets(Array("Descriptif", "CA prévsionnel 2012", "Contrats en cours", "Nouveaux contrats", "Prévisionnel PARC", "CA N-1", "Paramètres")).Copy
' Workbooks.Add
' ActiveSheet.Paste
' Application.CutCopyMode = False
'Enlève le quadrillage
ActiveWindow.DisplayGridlines = False
'cacher le référentiel
Sheets("Paramètres").Visible = xlSheetHidden
Sheets("CA N-1").Visible = xlSheetHidden
'Placement du curseur
Sheets("Descriptif").Select
Range("A1").Select
NomExport = "CA_PREVISIONNEL_2012_" & Format(agence, "000")
'& ".xls"
If Dir(CheminFicExport & NomExport) <> "" Then 'Le fichier existe-t-il déjà ? Si oui on pose la question à l'utilisateur.
If MsgBox("Le fichier " & NomExport & " existe déjà dans le répertoire de destination, voulez-vous écraser ce dernier ?", vbCritical + vbYesNo + vbDefaultButton2, "Avertissement") = vbYes Then
ActiveWorkbook.SaveAs CheminFicExport & NomExport
Else
ActiveWorkbook.Saved = True
End If
Else
ActiveWorkbook.SaveAs CheminFicExport & NomExport
End If
ActiveWorkbook.Close
End If 'If MonAgence.Text <> "" Then
Next 'For Each MonAgence In Range("Liste_Agence") Fin de la boucle sur les Agences.
Application.StatusBar = False 'Restore la barre d'état Excel d'origine
Application.DisplayAlerts = True 'Réactivation des messages d'alertes et les questions
Application.ScreenUpdating = True 'Réactivation du raffraichissement écran
Application.Cursor = xlDefault 'Enlève le sablier
Sheets("Menu").Select
Range("A1").Select
MsgBox "La génération des fichiers pour les agences sélectionnées est terminée", vbInformation + vbOKOnly, "Fin de génération"
End Sub |
Partager