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 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
| 'cette macro permet d'extraire le fichier texte et de le convertir en pdf et excel pour la paie et la compta
Option Explicit
Sub MAJhors24()
On Error GoTo Err_MAJhors24
Dim IndexFichier As Integer
Dim Flag As Boolean
Dim FlagEntete As Boolean
Dim Fichier As String
Dim FichierSource As String
Dim FichierCourt As String
Dim FichierCible As String
Dim FichierSauv As String
Dim FichierComptable As String
Dim Annee As String
Dim Mois As String
Dim CheminPaie As String
Dim CheminComptable As String
Dim ContenuLigne As String
Dim ContenuLigneSuivante As String
' Ouverture d'une boîte de dialogue pour que le gestionnaire sélectionne le fichier journal des rubriques issu du SIRH à traiter
Application.ScreenUpdating = False
Flag = False
FlagEntete = False
ChDrive "S:"
ChDir "S:\02034\PAIE"
' Accède au fichier
Fichier = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
"Sélectionnez un fichier :") 'Affectation du fichier sélectionné (ici Texte) à la variable oF1
' Test si le gestionnaire a bien choisi un fichier ou s'il a appuyé sur annuler
If Fichier <> "Faux" Then
' Séparation du chemin et du fichier lu
CheminPaie = Mid(Fichier, 1, InStrRev(Fichier, "\"))
FichierSource = Mid(Fichier, InStrRev(Fichier, "\") + 1, Len(Fichier) - InStrRev(Fichier, "\") - 4)
' Récupération de l'année dans le nom du fichier lu
Annee = Mid(Fichier, InStr(1, Fichier, "\PAIE") + 6, 4)
'Récupération du mois dans le nom du fichier lu
Mois = Mid(Fichier, InStr(1, Fichier, "\PAIE") + 16, 2)
' Définition du nom du dossier du mois dans le dossier COMPTABILITE
Select Case Mois
Case "01"
Mois = "01 - JANVIER " & Annee
Case "02"
Mois = "02 - FEVRIER " & Annee
Case "03"
Mois = "03 - MARS " & Annee
Case "04"
Mois = "04 - AVRIL " & Annee
Case "05"
Mois = "05 - MAI " & Annee
Case "06"
Mois = "06 - JUIN " & Annee
Case "07"
Mois = "07 - JUILLET " & Annee
Case "08"
Mois = "08 - AOUT " & Annee
Case "09"
Mois = "09 - SEPTEMBRE " & Annee
Case "10"
Mois = "10 - OCTOBRE " & Annee
Case "11"
Mois = "11 - NOVEMBRE " & Annee
Case "12"
Mois = "12 - DECEMBRE " & Annee
End Select
' Dérivation du nom du dossier comptable complet
CheminComptable = Mid(Fichier, 1, InStr(1, Fichier, "\PAIE") - 1) & "\COMPTABILITE\" & Annee & "\" & Mois & "\"
' Définition du nom du fichier cible (Total Societé)
FichierCible = FichierSource & " TOTAL SOCIETE.txt"
' On ouvre le fichier texte
IndexFichier = FreeFile()
Open Fichier For Input As #IndexFichier
While Not EOF(IndexFichier)
' On lit le fichier texte ligne a ligne en lisant 2 lignes car la notion de "TOTAL SOCIETE apparait sur la ligne 2 de chaque page. Quand on a trouvé
' la 1ere occurence de "TOTAL SOCIETE", on crée le fichier de sortie (Idem que fichier source mais suffixé avec "TOTAL SOCIETE". on écrit les 2 lignes
' lues et on positionne le flag entete pour ne plus lire par 2 lignes et écrire chaque ligne jusqu'à la fin du fichier source
If Flag = False Then
Line Input #IndexFichier, ContenuLigne ' lecture du fichier ligne par ligne : la variable contenuligne contient le contenu de la ligne active
Line Input #IndexFichier, ContenuLigneSuivante ' lecture de la ligne suivante (La notion de "TOTAL SOCIETE" apparait en ligne 2
Else
Line Input #IndexFichier, ContenuLigne
End If
If InStr(1, ContenuLigneSuivante, "POUR LA SOCIETE") <> 0 Then
Flag = True
End If
If Flag = True Then
If FlagEntete = False Then
Open FichierCible For Output Access Write As FreeFile
Print #2, ContenuLigne
Print #2, ContenuLigneSuivante
FlagEntete = True
Else
Print #2, ContenuLigne
End If
End If
Wend
Close #2
Close #1
' On supprime l'onglet Journal_Rubrique car on va le recréer
Application.DisplayAlerts = False
Sheets("Journal Rubrique").Delete
Application.DisplayAlerts = True
' On importe le fichier Texte
' Création de l'onglet journal rubrique avec conversion et mise en page txt vers excel
Workbooks.OpenText Filename:=FichierCible, Origin:=xlMSDOS, StartRow:=3, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(15, 1), Array(18, 1), Array(56, 1), Array(57, 1), Array(78, 1), Array(79, 1), Array(100, 1), _
Array(101, 1), Array(122, 1), Array(123, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Copy
Windows("CRNO Fichier Compta journal rub - Base.xlsm").Activate
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Name = "Journal Rubrique"
Range("A:A,D:D,F:F,H:H,J:K").Select
Selection.Delete shift:=xlToLeft
Range("A1").FormulaR1C1 = "Type"
Range("B1").FormulaR1C1 = "Libellé rubrique"
Range("C1").FormulaR1C1 = "Bases"
Range("D1").FormulaR1C1 = "Montant Salarial"
Range("E1").FormulaR1C1 = "Montant Patronal"
Columns("A:E").EntireColumn.AutoFit
Windows(FichierCible).Activate
activewindows.Close
' Copie du journal des Rubriques
Sheets("Journal Rubrique").Select
Range("A1:E600").Copy
Sheets("Journal rubriques paie").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Actualisation du TCD Par CompteComptable
Sheets("Par CompteComptable").Select
ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
' Actualisation du TCD Pour SELFI
Sheets("Pour SELFI").Select
ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
' Extraction du journal des rubriques à destination des gestionnaires Paie au format PDF
Sheets("Par CompteComptable").Select
Columns("A:I").Select
Application.CutCopyMode = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FichierSource & ".pdf", quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
' Sauvegarde du journal des rubriques à destination des gestionnaires Paie au format Excel
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Columns("A:I").EntireColumn.AutoFit
FichierSauv = Mid(FichierCible, 1, Len(FichierCible) - 4) & ".xlsx"
ActiveWindow.Close savechanges:=True, Filename:=FichierSauv
'Extraction du journal des rubriques à destination de l'outil de justification comptable au format PDF
Sheets("Pour SELFI").Select
Columns("A:F").Select
Application.CutCopyMode = False
FichierComptable = CheminComptable & FichierSource
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FichierComptable & ".pdf", quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
' Sauvegarde du journal des rubriques à destination de l'outil de justification comptable au format Excel
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Columns("A:F").EntireColumn.AutoFit
FichierSauv = FichierComptable & ".xlsx"
ActiveWindow.Close savechanges:=True, Filename:=FichierSauv
' Mise à jour des donnes d'actualisation
Sheets("Accueil").Select
Range("B3").Value = Now()
Range("B5").Value = FichierSource
' Ouverture du dossier Paie
ActiveWorkbook.FollowHyperlink CheminPaie, NewWindow:=True
ActiveWorkbook.Close savechanges:=True
Else
MsgBox "Sélection annulée par l'utilisateur ", vbInformation, err.Description
End If
Application.ScreenUpdating = True
GoTo Exit_MAJhors24
Err_MAJhors24:
Select Case err.Number
Case 5: MsgBox "Le disque S:\ n'est pas disponible - ", vbInformation, err.Description
Case 76: MsgBox "Le dossier 02034\PAIE n'existe pas sur S:\ - ", vbInformation, err.Description
Case Else: MsgBox "Erreur de MAJ du journal des rubriques - " & err.Number, vbInformation, err.Description
End Select
Exit_MAJhors24:
End Sub |
Partager