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
| Option Explicit
'Déclaration des variables globales
'Déclaration des fichiers
Private appExcel As Excel.Application 'Application Excel
Private Affectation As Workbook
Private Goracc As Workbook
Private Correspondance As Workbook
Private R13 As Workbook
Private nomFichier As String
Sub main()
Set appExcel = CreateObject("Excel.Application")
Form1.Show
End Sub
Sub SelectionFichier(nomFichier As String)
Dim fd As Application
' Créer un objet FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
' Titre de la boîte de dialogue
fd.Title = "Sélectionnez un fichier..."
' Ne pas autoriser la sélection multiple
' (donc 1 seul fichier est sélectionnable à la fois)
fd.AllowMultiSelect = False
' Afficher la boîte de dialogue
If fd.Show() Then
MsgBox "Vous avez sélectionné le fichier : " _
& vbCrLf & fd.SelectedItems(1), vbInformation
End If
'Ouverture du fichier en fonction du nom passé en paramètre
Select Case nomFichier
Case "FileAffectation"
Set Affectation = Workbooks.Open(fd.SelectedItems(1))
Case "FileGoracc"
Set Goracc = Workbooks.Open(fd.SelectedItems(1))
Case "FileCorrespondance"
Set Correspondance = Workbooks.Open(fd.SelectedItems(1))
Case "FileR13"
Set R13 = Workbooks.Open(fd.SelectedItems(1))
Case Else
MsgBox ("Erreur de selection. Contactez l'assistance technique.")
End Select
End Sub
'Fonction permettant de supprimer les lignes dont l'Horizontal est à 0 dans le fichier R13
Function supprimerLignesInutilesR13()
Dim nombreDeLigneR13 As Integer
Dim compteur As Integer
Dim nombreDeZero As Integer
'Récupère le nombre de ligne du fichier R13
nombreDeLigneR13 = R13.Sheets(3).UsedRange.Rows.Count
'Récupère le nombre de ligne dont l'horizontal a la valeur zero
nombreDeZero = calculNombreDeLignesASuppR13()
'Suppression des lignes dont l'horizontal est à zero, en supprimant la première ligne de données(= ligne 2)
For compteur = 2 To nombreDeZero + 2
R13.Worksheets(3).Rows(2).Delete
Next compteur
'Sauvegarde du fichier modifié
R13.Save
End Function
'calcul le nombre de lignes dont l'horizontal est à zero
Function calculNombreDeLignesASuppR13()
'Saute l'entête de la feuille Excel. Compteur commence à 2
For compteur = 2 To nombreDeLigneR13
If ((R13.Worksheets(3).Cells(compteur, 11).Value) = 0) Then
nombreDeZero = nombreDeZero + 1
End If
Next compteur
calculNombreDeLignesASuppR13 = nombreDeZero
End Function
'Tri du fichier sur la valeur de l'Horizontal
Sub TriFichierR13SurValHorizontal()
'Active le Worsheets numéro 3
R13.Worksheets(3).Activate
'Tri du fichier
R13.Worksheets(3).Range("A2:N" & nombreDeLigneR13).Select
Selection.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Sauvegarde du fichier
R13.Save
End Sub
'Fonction principale
Sub execute()
'Tri du fichier R13
Call TriFichierR13SurValHorizontal
'Suppression des lignes inutiles dans R13
Call supprimerLignesInutilesR13
MsgBox ("Fin du traitement")
End Sub |
Partager