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
| 'Procédure principale se trouvant dans le classeur Appro matiere
Sub Main()
Dim i As Long
Dim ApproMatiere As Workbook
Dim Entree As Workbook
Set ApproMatiere = ThisWorkbook
Application.ScreenUpdating = False 'Pas de mise à jour en temps réel
With ApproMatiere.Worksheets("Feuil1") 'Dans le classeur Appro matiere, feuil1
For i = 2 To 200 Step 1 'on parcourt toutes les cellules de notre plage
EXPEDITION_DONNEES Entree, .Range("O" & i) 'et on fait appel à la procédure paramétrée EXPEDITION_DONNES qu'on applique à notre classeur Appro matieres.xlxs
Next i 'contenu dans la variable Entree en prenant compte à chaque tours de boucle de la cellule D1, D3,D5...
End With
With ApproMatiere.Worksheets("Feuil1")
For i = 2 To 200 Step 1
CLASSE_DONNEES Entree, .Range("O" & i) 'puis, on fait appel à la procédure CLASSE_DONNEES qui s'applique sur le classeur Appro matiere
Next i
End With
ThisWorkbook.Save
End Sub
'La procédure CLASSE_DONNEES prends en paramètre un classeur Wbk et une cellule c
'En fonction de la cellule c, on insère une ligne à la place de la ligne 2 dans la feuille Classé de notre classeur Appro matiere
'Ensuite, on copie les données des cellules A,B,C,D,E,F,G,H,I,J,K,L,M de la même ligne que c vers A2:M2 de "Classé" toujours
'dans notre classeur Appro matiere
Private Sub CLASSE_DONNEES(ByVal Wbk As Workbook, ByVal c As Range)
ThisWorkbook.Sheets("Classé").Unprotect "SERTA" 'On déverrouille les deux feuilles dans lesquelles on va travailler
Sheets("Feuil1").Unprotect "SERTA"
If Not IsEmpty(c) Then
With ThisWorkbook.Sheets("Classé") 'On va dans la feuille "Classée" du classeur Appro matiere
.Rows(2).Insert Shift:=xlDown 'On insert une ligne sur la feuille "Classée"
.Rows(2).RowHeight = 15
.Rows(2).Orientation = xlHorizontal
.Range("A2:O2").Value = c.Offset(0, -14).Resize(1, 15).Value 'On copie la ligne
.Range("P2") = Date 'On ajoute la date du classement de la ligne
End With
With ThisWorkbook.Sheets("Feuil1") 'On retourne sur le feuil1
c.EntireRow.Delete 'On supprime la ligne qui vient d'être classée
End With
End If
ThisWorkbook.Sheets("Classé").Protect "SERTA" 'On déverrouille les deux feuilles dans lesquelles on va travailler
Sheets("Feuil1").Protect "SERTA"
End Sub
'La procédure EXPEDITION_DONNEES prends en paramètre un classeur Wbk et une cellule c
'En fonction de la cellule c, on ouvre un classeur dont son nom se compose de deux cellules et on y copie, dans une cellule dont ces coordonnées
'coordonnées sont définies par un calcul, le continue de la cellule c.
'On enregistre le classeur que l'on vient d'ouvrir et on le ferme.
Private Sub EXPEDITION_DONNEES(ByVal Wbk As Workbook, ByVal c As Range)
Dim Fichier1 As String
Dim Fichier2 As String
Dim Ligne As String
Dim ContCellule As String
Dim DestCellule As String
Dim DestCellule2 As String
Dim Entree As Workbook
Dim ApproMatiere As Workbook
If Not IsEmpty(c) Then 'Si c n'est pas vide
Const Repertoire = "\\Srvserta\SERTA PARTAGE\GESTION MATIERE\ENREGISTREMENT" 'adresse des sauvegarde de fueilles de débit
With ThisWorkbook.Sheets("Feuil1") 'Feuil1 du classeur appro matiere
Fichier1 = c.Offset(0, -14).Value 'première partie du nom du classeur à ouvrir
Fichier2 = c.Offset(0, -4).Value 'deuxième partie du nom du classeur à ouvrir
NomClasseur = Repertoire & "\" & Fichier1 & " - " & Fichier2 & ".xlsm" 'adresse + nom du classeur à ouvrir
End With
With ThisWorkbook.Sheets("Feuil1") 'dans le classeur appro matière
ContCellule = c.Offset(0, 1).Value 'N° ligne concerné
Ligne = ContCellule * 2 + 5 'Calcul permettant d'associer le n°ligne au n°OF de la feuille de débit
DestCellule = "AC" & Ligne 'Définition de la cellule concernée
DestCellule2 = "Z" & Ligne
End With
Set Entree = Workbooks.Open(NomClasseur) 'ouverture du classeur concernée
With Entree.Sheets("Feuil1") 'on sélectionne le classeur
.Range(DestCellule).Value = c.Value 'on copie la cellule
.Range(DestCellule2).Value = c.Offset(0, -5).Value
End With
'Entree.Sheets("Feuil1").PrintOut , , 1 'Imprime la feuille de débit modifiée
Entree.Close True 'on enregistre et on ferme
End If
End Sub |
Partager