Problème d'effacement sur mon onglet
l
Bonjour à tous,
J'ai un code qui me permet de télécharger des données d'un autre fichier Excel et ensuite de les introduire dans un onglet de mon fichier. Mais avant d'introduire les infos, normalement il m'écrase les anciennes données pour éviter tout risque de mauvaise informations, mais quand je réalise mon code, l'opération n'a pas lieu.
Pouvez-vous m'aider ??
verification_DI_SNO:
verification = MsgBox("Souhaitez vous incorporer la liste des DI SNO ?", 3)
If verification = 6 Then
fichier_osmose_DI = Application.GetOpenFilename(Title:="Fichier Osmose Demandes d'intervention DI SNO")
If fichier_osmose_DI <> False Then
Workbooks.Open (fichier_osmose_DI)
Else
MsgBox ("Erreur : pas de fichier Osmose DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SNO
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_DI = fs.getfilename(fichier_osmose_DI)
Set table_DI_dashboard = dashboard.Sheets("DI")
Set table_osmose_di = Workbooks(nom_fichier_osmose_DI).ActiveSheet
If table_osmose_di.Cells(1, 1) <> "N°" Or _
table_osmose_di.Cells(1, 2) <> "N° Massifiante" Or _
table_osmose_di.Cells(1, 3) <> "Code Opération" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de DI." & Chr(10) & " Veuillez réessayer.")
GoTo verification_DI_SNO
Else
num_vehicule = table_osmose_di.Cells(2, col_NoEff_DI + 2)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SNO" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de DI de la flotte SNO. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SNO
End If
End If
'remise à 0 de la feuille destination
table_DI_dashboard.AutoFilterMode = False
Range(table_DI_dashboard.Cells(1, 1), table_DI_dashboard.Cells(1, colonne_flotte_DI2)).AutoFilter
table_DI_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_DI_dashboard.Cells(1, colonne_flotte_DI2), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With table_DI_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_DI_dashboard.Cells(i, colonne_flotte_DI2) = "SNO" Or table_DI_dashboard.Cells(i, colonne_flotte_DI2) = ""
i = i + 1
Loop
i = i
Range(table_DI_dashboard.Cells(1, colonne_flotte_DI2).Offset(i - 1, 0), table_DI_dashboard.Cells(1, colonne_flotte_DI2).End(xlToLeft).End(xlDown)).Clear
'supression des Colonnes F et G (maj du 22/06/2018)
table_osmose_di.Columns("F:G").Delete Shift:=xlToLeft
'recopie du fichier DI source
For j = 28 To 31
table_osmose_di.Cells(1, j) = "REMPLISSAGE"
Next j
j = 2
Do Until table_osmose_di.Cells(j, 1) = ""
table_osmose_di.Cells(j, colonne_flotte_DI2) = "SNO"
j = j + 1
Loop
Range(table_osmose_di.Cells(1, 1).Offset(1, 0), table_osmose_di.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_DI_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
Bonjour,
Désolé, mais alors là comme ça, sans fichier, sans balises </> et sans indentation, ton code est illisible ...
l
Et si je le met comme ça ? mon fichier est trop lourd pour y être envoyé.
verification_DI_SLN:
verification = MsgBox("Souhaitez vous incorporer la liste des DI SLN ?", 3)
If verification = 6 Then
fichier_osmose_DI = Application.GetOpenFilename(Title:="Fichier Osmose Demandes d'intervention DI SLN")
If fichier_osmose_DI <> False Then
Workbooks.Open (fichier_osmose_DI)
Else
MsgBox ("Erreur : pas de fichier Osmose DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SLN
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_DI = fs.getfilename(fichier_osmose_DI)
Set table_DI_dashboard = dashboard.Sheets("DI")
Set table_osmose_di = Workbooks(nom_fichier_osmose_DI).ActiveSheet
'verification qu'il sagit d'un fichier de DI SLN
If table_osmose_di.Cells(1, 1) <> "N°" Or _
table_osmose_di.Cells(1, 2) <> "N° Massifiante" Or _
table_osmose_di.Cells(1, 3) <> "Code Opération" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SLN
Else
num_vehicule = table_osmose_di.Cells(2, col_NoEff_DI + 2)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SLN" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de DI de la flotte SLN." & Chr(10) & " Veuillez réessayer.")
GoTo verification_DI_SLN
End If
End If
'remise à 0 de la feuille destination
table_DI_dashboard.AutoFilterMode = False
Range(table_DI_dashboard.Cells(1, 1), table_DI_dashboard.Cells(1, colonne_flotte_DI2)).AutoFilter
table_DI_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_DI_dashboard.Cells(1, colonne_flotte_DI2), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With table_DI_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_DI_dashboard.Cells(i, colonne_flotte_DI2) = "SLN" Or table_DI_dashboard.Cells(i, colonne_flotte_DI2) = ""
i = i + 1
Loop
i = i
Range(table_DI_dashboard.Cells(1, colonne_flotte_DI2).Offset(i - 1, 0), table_DI_dashboard.Cells(1, colonne_flotte_DI2).End(xlToLeft).End(xlDown)).Clear
'supression des Colonnes F et G (maj du 22/06/2018)
table_osmose_di.Columns("F:G").Delete Shift:=xlToLeft
'recopie du fichier DI source
For j = 28 To 31
table_osmose_di.Cells(1, j) = "REMPLISSAGE"
Next j
j = 2
Do Until table_osmose_di.Cells(j, 1) = ""
table_osmose_di.Cells(j, colonne_flotte_DI2) = "SLN"
j = j + 1
Loop
Range(table_osmose_di.Cells(1, 1).Offset(1, 0), table_osmose_di.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_DI_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End Ifok c'est super,
je regarde et vais sans doute te poser des questions ...
déjà, quelle est la partie du code qui d'après toi ne fonctionne pas ?
l
Pour moi c'est quand je demande de remettre à zéro l'onglet DI de mon fichier. Car quand j'applique se code VBA :
dashboard.Sheets("DI").Range("A2:AE10000").ClearContentstout va pour le mieux, mais c'est vraiment pas terrible pour mon utilisation.
Car je fais deux extractions de 2 fichiers différents mais qui se rajoute à la suite sur le même onglet. Mais si je veux incorporer seulement l'extraction n°1, je veux que ça soit seulement l'extraction n°1 qui s'efface et non l'extraction n°2.
Pour bien les différentier, en AE de mon onglet "DI" j'ai un macro qui me dit si c'est une extraction "SNO" ou "SLN"
Cordialement
N'hésite pas à inclure des debug.print "ici" ou debug.print ma_variable en affichant par Ctrl+G dans l'éditeur de macro la fenêtre d'exécution.
Tu peux aussi remplacer debug.print par msgbox
dashboard (tout seul) n'est défini nul part ... ! ?
l
Si c'est une variable, si dessous mon code au complet :
Option Explicit
Sub MAJ_extractions()
Dim fichier_ourson As Variant
Dim fichier_osmose_DI As Variant
Dim fichier_osmose_restriction As Variant
Dim fichier_osmose_MR As Variant
Dim fichier_coupon As Variant
Dim table_osmose_mr As Variant
Dim fs As Object
Dim table_restriction_dashboard As Worksheet
Dim table_osmose_di As Worksheet
Dim table_DI_dashboard As Worksheet
Dim table_mr_dashboard As Worksheet
Dim HOME As Worksheet
Dim table_B82500 As Worksheet
Dim table_B84500 As Worksheet
Dim table_B85900 As Worksheet
Dim table_X72500 As Worksheet
Dim table_X73500 As Worksheet
Dim table_X76500 As Worksheet
Dim table_Z27500_3C As Worksheet
Dim table_Z27500_4C As Worksheet
Dim table_BB15000_NR As Worksheet
Dim table_BB15000_R As Worksheet
Dim table_BB26000 As Worksheet
Dim table_BB63500 As Worksheet
Dim table_CORAIL_BN As Worksheet
Dim table_CORAIL_HN As Worksheet
Dim table_TER2N_NG As Worksheet
Dim table_V2N As Worksheet
Dim table_VO2N As Worksheet
Dim table_OMNEO As Worksheet
Dim table_ope_evitement As Worksheet
Dim table_param_serie As Worksheet
Dim dashboard As Workbook
Dim table_MR As Worksheet
Dim table_DI As Worksheet
Dim table_OURSON As Worksheet
Dim table_Restriction As Worksheet
Dim table_osmose_restriction As Worksheet
Dim table_ourson_dashboard As Worksheet
Set dashboard = ThisWorkbook
Set table_mr_dashboard = dashboard.Sheets("MR")
Set HOME = dashboard.ActiveSheet
Set table_DI_dashboard = dashboard.Sheets("DI")
Set table_B82500 = dashboard.Sheets("B82500")
Set table_B84500 = dashboard.Sheets("B84500")
Set table_B85900 = dashboard.Sheets("B85900")
Set table_X72500 = dashboard.Sheets("X72500")
Set table_X73500 = dashboard.Sheets("X73500")
Set table_X76500 = dashboard.Sheets("X76500")
Set table_Z27500_3C = dashboard.Sheets("Z27500_3C")
Set table_Z27500_4C = dashboard.Sheets("Z27500_4C")
Set table_BB15000_NR = dashboard.Sheets("BB15000_NR")
Set table_BB15000_R = dashboard.Sheets("BB15000_R")
Set table_BB26000 = dashboard.Sheets("BB26000")
Set table_BB63500 = dashboard.Sheets("BB63500")
Set table_CORAIL_BN = dashboard.Sheets("CORAIL_BN")
Set table_CORAIL_HN = dashboard.Sheets("CORAIL_HN")
Set table_TER2N_NG = dashboard.Sheets("TER_2N_NG")
Set table_V2N = dashboard.Sheets("V2N")
Set table_VO2N = dashboard.Sheets("VO2N")
Set table_OMNEO = dashboard.Sheets("OMNEO")
Set table_ope_evitement = dashboard.Sheets("ope evitement")
Dim nom_fichier_ourson As String
Dim nom_fichier_osmose_restriction As String
Dim nom_fichier_osmose_MR As String
Dim nom_fichier_osmose_DI As String
Dim colonne_butee_temps As Integer
Dim colonne_butee_km As Integer
Dim colonne_statut_osmose As Integer
Dim colonne_nb_vt As Integer
Dim colonne_reforme As Integer
Dim colonne_restriction As Integer
Dim colonne_peremption As Integer
Dim ajout_OURSON As Integer
Dim colonne_flotte_DI2 As Integer
Dim colonne_flotte_MR As Integer
Dim colonne_flotte_restriction As Integer
Dim col_NoEff_DI As Integer
Dim col_NoEff_Restri As Integer
Dim i As Integer
Dim j As Integer
Dim tag_fin As String
Dim EM_en_cours As String
Dim coupon_en_cours As String
Dim verification As Integer
Dim num_vehicule As String
'Paramétrage des colonnes des l'onglets
colonne_butee_temps = 7
colonne_butee_km = 8
colonne_statut_osmose = 11
colonne_nb_vt = 2
colonne_restriction = 5
colonne_reforme = 10
'colonne_correctif = 13
colonne_peremption = 9
'colonne_reference_toutes_DI = 29
'colonne_reference_alerte_feuille_journaliere = 30
ajout_OURSON = 0
colonne_flotte_DI2 = 31
colonne_flotte_MR = 7
colonne_flotte_restriction = 12
col_NoEff_DI = 7
col_NoEff_Restri = 7
'===============================
'insertion du fichier DI SLN/SNO
'===============================
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
verification_DI_SLN:
verification = MsgBox("Souhaitez vous incorporer la liste des DI SLN ?", 3)
If verification = 6 Then
fichier_osmose_DI = Application.GetOpenFilename(Title:="Fichier Osmose Demandes d'intervention DI SLN")
If fichier_osmose_DI <> False Then
Workbooks.Open (fichier_osmose_DI)
Else
MsgBox ("Erreur : pas de fichier Osmose DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SLN
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_DI = fs.getfilename(fichier_osmose_DI)
Set table_DI_dashboard = dashboard.Sheets("DI")
Set table_osmose_di = Workbooks(nom_fichier_osmose_DI).ActiveSheet
'verification qu'il sagit d'un fichier de DI SLN
If table_osmose_di.Cells(1, 1) <> "N°" Or _
table_osmose_di.Cells(1, 2) <> "N° Massifiante" Or _
table_osmose_di.Cells(1, 3) <> "Code Opération" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SLN
Else
num_vehicule = table_osmose_di.Cells(2, col_NoEff_DI + 2)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SLN" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de DI de la flotte SLN." & Chr(10) & " Veuillez réessayer.")
GoTo verification_DI_SLN
End If
End If
'remise à 0 de la feuille destination
table_DI_dashboard.AutoFilterMode = False
Range(table_DI_dashboard.Cells(1, 1), table_DI_dashboard.Cells(1, colonne_flotte_DI2)).AutoFilter
table_DI_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_DI_dashboard.Cells(1, colonne_flotte_DI2), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With table_DI_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_DI_dashboard.Cells(i, colonne_flotte_DI2) = "SLN" Or table_DI_dashboard.Cells(i, colonne_flotte_DI2) = ""
i = i + 1
Loop
i = i
Range(table_DI_dashboard.Cells(1, colonne_flotte_DI2).Offset(i - 1, 0), table_DI_dashboard.Cells(1, colonne_flotte_DI2).End(xlToLeft).End(xlDown)).Clear
'supression des Colonnes F et G (maj du 22/06/2018)
table_osmose_di.Columns("F:G").Delete Shift:=xlToLeft
'recopie du fichier DI source
For j = 28 To 31
table_osmose_di.Cells(1, j) = "REMPLISSAGE"
Next j
j = 2
Do Until table_osmose_di.Cells(j, 1) = ""
table_osmose_di.Cells(j, colonne_flotte_DI2) = "SLN"
j = j + 1
Loop
Range(table_osmose_di.Cells(1, 1).Offset(1, 0), table_osmose_di.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_DI_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
verification_DI_SNO:
verification = MsgBox("Souhaitez vous incorporer la liste des DI SNO ?", 3)
If verification = 6 Then
fichier_osmose_DI = Application.GetOpenFilename(Title:="Fichier Osmose Demandes d'intervention DI SNO")
If fichier_osmose_DI <> False Then
Workbooks.Open (fichier_osmose_DI)
Else
MsgBox ("Erreur : pas de fichier Osmose DI." & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SNO
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_DI = fs.getfilename(fichier_osmose_DI)
Set table_DI_dashboard = dashboard.Sheets("DI")
Set table_osmose_di = Workbooks(nom_fichier_osmose_DI).ActiveSheet
If table_osmose_di.Cells(1, 1) <> "N°" Or _
table_osmose_di.Cells(1, 2) <> "N° Massifiante" Or _
table_osmose_di.Cells(1, 3) <> "Code Opération" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de DI." & Chr(10) & " Veuillez réessayer.")
GoTo verification_DI_SNO
Else
num_vehicule = table_osmose_di.Cells(2, col_NoEff_DI + 2)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SNO" Then
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de DI de la flotte SNO. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_DI_SNO
End If
End If
'remise à 0 de la feuille destination
table_DI_dashboard.AutoFilterMode = False
Range(table_DI_dashboard.Cells(1, 1), table_DI_dashboard.Cells(1, colonne_flotte_DI2)).AutoFilter
table_DI_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_DI_dashboard.Cells(1, colonne_flotte_DI2), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With table_DI_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_DI_dashboard.Cells(i, colonne_flotte_DI2) = "SNO" Or table_DI_dashboard.Cells(i, colonne_flotte_DI2) = ""
i = i + 1
Loop
i = i
Range(table_DI_dashboard.Cells(1, colonne_flotte_DI2).Offset(i - 1, 0), table_DI_dashboard.Cells(1, colonne_flotte_DI2).End(xlToLeft).End(xlDown)).Clear
'supression des Colonnes F et G (maj du 22/06/2018)
table_osmose_di.Columns("F:G").Delete Shift:=xlToLeft
'recopie du fichier DI source
For j = 28 To 31
table_osmose_di.Cells(1, j) = "REMPLISSAGE"
Next j
j = 2
Do Until table_osmose_di.Cells(j, 1) = ""
table_osmose_di.Cells(j, colonne_flotte_DI2) = "SNO"
j = j + 1
Loop
Range(table_osmose_di.Cells(1, 1).Offset(1, 0), table_osmose_di.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_DI_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_DI).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
'=============================================
'insertion du fichier matériel roulant SLN/SNO
'=============================================
verification_MR_SLN:
verification = MsgBox("Souhaitez vous incorporer la liste des MR SLN ?", 3)
If verification = 6 Then
fichier_osmose_MR = Application.GetOpenFilename(Title:="Fichier Osmose matériel roulant MR SLN")
If fichier_osmose_MR <> False Then
Workbooks.Open (fichier_osmose_MR)
Else
MsgBox ("Erreur : pas de fichier Osmose MR." & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SLN
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_MR = fs.getfilename(fichier_osmose_MR)
Set table_mr_dashboard = dashboard.Sheets("MR")
Set table_osmose_mr = Workbooks(nom_fichier_osmose_MR).ActiveSheet
If table_osmose_mr.Cells(1, 1) <> "N° immatriculation EF" Or _
table_osmose_mr.Cells(1, 2) <> "N° identification européenne" Or _
table_osmose_mr.Cells(1, 3) <> "Clé GMAO" Then
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de MR. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SLN
Else
If table_osmose_mr.Cells(2, colonne_flotte_MR) <> "SLN" Then
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de MR de la flotte SLN. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SLN
End If
End If
'remise à 0 de la feuille destination
table_mr_dashboard.AutoFilterMode = False
Range(table_mr_dashboard.Cells(1, 1), table_mr_dashboard.Cells(1, 1).End(xlToRight).Offset(0, 1)).AutoFilter
table_mr_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_mr_dashboard.Cells(1, colonne_flotte_MR), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With table_mr_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_mr_dashboard.Cells(i, colonne_flotte_MR) = "SLN" Or table_mr_dashboard.Cells(i, colonne_flotte_MR) = ""
i = i + 1
Loop
Range(table_mr_dashboard.Cells(1, 1).End(xlToRight).Offset(i - 1, 1), table_mr_dashboard.Cells(1, 1).End(xlDown)).Clear
'recopie du fichier mr source
Range(table_osmose_mr.Cells(1, 1).Offset(1, 0), table_osmose_mr.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_mr_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
verification_MR_SNO:
verification = MsgBox("Souhaitez vous incorporer la liste des MR SNO ?", 3)
If verification = 6 Then
fichier_osmose_MR = Application.GetOpenFilename(Title:="Fichier Osmose matériel roulant MR SNO")
If fichier_osmose_MR <> False Then
Workbooks.Open (fichier_osmose_MR)
Else
MsgBox ("Erreur : pas de fichier Osmose MR." & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SNO
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_MR = fs.getfilename(fichier_osmose_MR)
Set table_mr_dashboard = dashboard.Sheets("MR")
Set table_osmose_mr = Workbooks(nom_fichier_osmose_MR).ActiveSheet
If table_osmose_mr.Cells(1, 1) <> "N° immatriculation EF" Or _
table_osmose_mr.Cells(1, 2) <> "N° identification européenne" Or _
table_osmose_mr.Cells(1, 3) <> "Clé GMAO" Then
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de MR. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SNO
Else
If table_osmose_mr.Cells(2, colonne_flotte_MR) <> "SNO" Then
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de MR de la flotte SNO. " & Chr(10) & "Veuillez réessayer.")
GoTo verification_MR_SNO
End If
End If
'remise à 0 de la feuille destination
table_mr_dashboard.AutoFilterMode = False
Range(table_mr_dashboard.Cells(1, 1), table_mr_dashboard.Cells(1, 1).End(xlToRight).Offset(0, 1)).AutoFilter
table_mr_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_mr_dashboard.Cells(1, colonne_flotte_MR), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With table_mr_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_mr_dashboard.Cells(i, colonne_flotte_MR) = "SNO" Or table_mr_dashboard.Cells(i, colonne_flotte_MR) = ""
i = i + 1
Loop
Range(table_mr_dashboard.Cells(1, 1).End(xlToRight).Offset(i - 1, 1), table_mr_dashboard.Cells(1, 1).End(xlDown)).Clear
'recopie du fichier mr source
Range(table_osmose_mr.Cells(1, 1).Offset(1, 0), table_osmose_mr.Cells(1, 1).End(xlToRight).End(xlDown)).Copy (table_mr_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_MR).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
'========================================
'insertion du fichier Restriction SLN/SNO
'========================================
'verification_restriction_SLN:
verification = MsgBox("Souhaitez vous incorporer la liste des restriction SLN ?", 3)
If verification = 6 Then
fichier_osmose_restriction = Application.GetOpenFilename(Title:="Fichier Osmose restriction SLN")
If fichier_osmose_restriction <> False Then
Workbooks.Open (fichier_osmose_restriction)
Else
MsgBox ("Erreur : pas de fichier Osmose restriction." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SLN
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_restriction = fs.getfilename(fichier_osmose_restriction)
Set table_restriction_dashboard = dashboard.Sheets("restriction")
Set table_osmose_restriction = Workbooks(nom_fichier_osmose_restriction).ActiveSheet
If table_osmose_restriction.Cells(1, 1) <> "Restriction" Or _
table_osmose_restriction.Cells(1, 2) <> "Statut" Or _
table_osmose_restriction.Cells(1, 3) <> "Description" Then
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de restriction." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SLN
Else
num_vehicule = table_osmose_restriction.Cells(2, col_NoEff_Restri)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SLN" Then
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de restriction de la flotte SLN." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SLN
End If
End If
'remise à 0 de la feuille destination
table_restriction_dashboard.AutoFilterMode = False
Range(table_restriction_dashboard.Cells(1, 1), table_restriction_dashboard.Cells(1, 1).End(xlToRight).Offset(0, 1)).AutoFilter
table_restriction_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_restriction_dashboard.Cells(1, colonne_flotte_restriction), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With table_restriction_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_restriction_dashboard.Cells(i, colonne_flotte_restriction) = "SLN" Or table_restriction_dashboard.Cells(i, colonne_flotte_restriction) = ""
i = i + 1
Loop
Range(table_restriction_dashboard.Cells(1, 1).End(xlToRight).Offset(i - 1, 1), table_restriction_dashboard.Cells(1, 1).End(xlDown)).Clear
'recopie du fichier restriction source
j = 2
Do Until table_osmose_restriction.Cells(j, 1) = ""
table_osmose_restriction.Cells(j, colonne_flotte_restriction) = "SLN"
j = j + 1
Loop
Range(table_osmose_restriction.Cells(1, 1).Offset(1, 0), table_osmose_restriction.Cells(1, 1).End(xlToRight).Offset(1, 1).End(xlDown)).Copy (table_restriction_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
verification_restriction_SNO:
verification = MsgBox("Souhaitez vous incorporer la liste des restriction SNO ?", 3)
If verification = 6 Then
fichier_osmose_restriction = Application.GetOpenFilename(Title:="Fichier Osmose restriction SNO")
If fichier_osmose_restriction <> False Then
Workbooks.Open (fichier_osmose_restriction)
Else
MsgBox ("Erreur : pas de fichier Osmose restriction." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SNO
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_osmose_restriction = fs.getfilename(fichier_osmose_restriction)
Set table_restriction_dashboard = dashboard.Sheets("restriction")
Set table_osmose_restriction = Workbooks(nom_fichier_osmose_restriction).ActiveSheet
If table_osmose_restriction.Cells(1, 1) <> "Restriction" Or _
table_osmose_restriction.Cells(1, 2) <> "Statut" Or _
table_osmose_restriction.Cells(1, 3) <> "Description" Then
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas un fichier de restriction." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SNO
Else
num_vehicule = table_osmose_restriction.Cells(2, col_NoEff_Restri)
i = 2
Do Until table_mr_dashboard.Cells(i, 1) = num_vehicule Or table_mr_dashboard.Cells(i, 1) = ""
i = i + 1
Loop
If table_mr_dashboard.Cells(i, 1) <> num_vehicule Or table_mr_dashboard.Cells(i, colonne_flotte_MR) <> "SNO" Then
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
MsgBox ("Le fichier ouvert n'est pas le fichier de restriction de la flotte SNO." & Chr(10) & "Veuillez réessayer.")
GoTo verification_restriction_SNO
End If
End If
'remise à 0 de la feuille destination
table_restriction_dashboard.AutoFilterMode = False
Range(table_restriction_dashboard.Cells(1, 1), table_restriction_dashboard.Cells(1, 1).End(xlToRight).Offset(0, 1)).AutoFilter
table_restriction_dashboard.AutoFilter.Sort.SortFields.Add _
Key:=table_restriction_dashboard.Cells(1, colonne_flotte_restriction), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With table_restriction_dashboard.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
Do Until table_restriction_dashboard.Cells(i, colonne_flotte_restriction) = "SNO" Or table_restriction_dashboard.Cells(i, colonne_flotte_restriction) = ""
i = i + 1
Loop
Range(table_restriction_dashboard.Cells(1, 1).End(xlToRight).Offset(i - 1, 1), table_restriction_dashboard.Cells(1, 1).End(xlDown)).Clear
'recopie du fichier restriction source
j = 2
Do Until table_osmose_restriction.Cells(j, 1) = ""
table_osmose_restriction.Cells(j, colonne_flotte_restriction) = "SNO"
j = j + 1
Loop
Range(table_osmose_restriction.Cells(1, 1).Offset(1, 0), table_osmose_restriction.Cells(1, 1).End(xlToRight).Offset(1, 1).End(xlDown)).Copy (table_restriction_dashboard.Cells(i, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
Application.CutCopyMode = False
Workbooks(nom_fichier_osmose_restriction).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
'===============================
'insertion du fichier ourson SLN
'===============================
'verification_OURSON:
ajout_OURSON = MsgBox("Souhaitez vous incorporer l'extraction OURSON ?", 3)
If ajout_OURSON = 6 Then
fichier_ourson = Application.GetOpenFilename(Title:="Fichier Ourson Coupon")
If fichier_ourson <> False Then
Workbooks.Open (fichier_ourson)
Else
MsgBox ("Erreur : pas de fichier OURSON." & Chr(10) & "Veuillez réessayer.")
GoTo verification_OURSON
End If
Set fs = CreateObject("Scripting.FileSystemObject")
nom_fichier_ourson = fs.getfilename(fichier_ourson)
Set table_ourson_dashboard = dashboard.Sheets("OURSON")
Set table_OURSON = Workbooks(nom_fichier_ourson).ActiveSheet
If table_OURSON.Cells(3, 1) <> "Coupon physique" Or _
table_OURSON.Cells(4, 3) <> "Catégories attendues" Or _
table_OURSON.Cells(4, 4) <> "Catégories réelles" Then
MsgBox ("Le fichier Ouvert n'est pas un fichier OURSON." & Chr(10) & "Veuillez réessayer.")
Workbooks(nom_fichier_ourson).Close Savechanges:=False
GoTo verification_OURSON
End If
'remise à 0 de la feuille destination
table_ourson_dashboard.Cells.Value = ""
'recopie du fichier DI source
table_OURSON.Cells.Copy (table_ourson_dashboard.Cells(1, 1))
'on met dans le presse papier une seule cellule pour éviter le message d'avertissement
table_OURSON.Cells(1, 1).Copy
Workbooks(nom_fichier_ourson).Close Savechanges:=False
ElseIf verification = 2 Then
MsgBox ("Arrêt du programme")
End
End If
'==========================================
'MAJ du numéro de coupon dans le fichier DI
'==========================================
'on trie par numéro d'engin pour aller plus vite dans la mise à jour par la suite
table_DI_dashboard.Activate
table_DI_dashboard.Columns("A:AA").Select
table_DI_dashboard.Sort.SortFields.Clear
table_DI_dashboard.Sort.SortFields.Add Key:=Range("G2:G20000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With table_DI_dashboard.Sort
.SetRange Range("A1:AA20000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
While table_DI_dashboard.Cells(i, 1).Value <> ""
'si la maj n'est pas encore faite et qu'il s'agit d'un nouvel EM
If table_DI_dashboard.Cells(i, 28).Value = "" And _
table_DI_dashboard.Cells(i, 7).Value <> EM_en_cours Then
'on cherche le numéro de coupon
EM_en_cours = table_DI_dashboard.Cells(i, 7).Value
j = 2
tag_fin = "non"
While table_mr_dashboard.Cells(j, 1).Value <> "" And tag_fin = "non"
If CStr(table_mr_dashboard.Cells(j, 1).Value) = EM_en_cours Then
coupon_en_cours = table_mr_dashboard.Cells(j, 13).Value
tag_fin = "oui"
End If
j = j + 1
Wend
table_DI_dashboard.Cells(i, 23).Value = coupon_en_cours
table_DI_dashboard.Cells(i, 28).Value = "maj coupon"
'sinon on recopie le numéro de coupon déjà mémorisé
Else
table_DI_dashboard.Cells(i, 23).Value = coupon_en_cours
table_DI_dashboard.Cells(i, 28).Value = "maj coupon"
End If
i = i + 1
Wend
End SubBon ben il y a du code !!
Je crains qu'il faille voir le fichier (simplifié) pour s'en sortir avec un ou deux exemples de fichiers à importer (même bidon) !
l
Bonjour Steelson,
Désolé de ne pas avoir répondu plus tôt mais j'ai étais pris.
Je ne peux pas envoyer mon fichier, il est trop lourd. et si je le bride il débloque de partout