Macro excel fonctionne sous xp mais pas sous seven
Pir27
-
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je ne sais pas si j'écris au bon endroit (macro excel ou bien windows 7).
J'ai créé une macro avec l'aide précieuse de michel_m et f894009 (merci encore) dans la question "Modification d'un tableau à partir de 2 fichiers Excell" en Octobre 2013.
Cette macro marchait à merveille sous windows XP.
Je viens de passer sous Windows 7. La macro tourne (aucun message d'erreur) mais le fichier qui doit être modifié ne l'est pas du tout.
La version d'excell est la même que sous XP (Excel 2010).
Voici la macro en question :
Sub traitement_enregistrementsFLE()
Dim derlig1 As Integer, derlig2 As Integer
Dim Dico1, Dico2, cel, Plage_ID2, Plage_ID1
Dim CeClasseur, Fichier_Ouvrir, nom_Fichier As String
Application.ScreenUpdating = False
CeClasseur = ThisWorkbook.Name
'si repertoire connu
'Chdir="C:\mon_repertoire"
'boite a dialogue
Fichier_Ouvrir = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
'test si fichier choisi
If Fichier_Ouvrir <> False Then
nom_Fichier = Right(Fichier_Ouvrir, Len(Fichier_Ouvrir) - InStrRev(Fichier_Ouvrir, "\"))
Else
MsgBox ("PAS DE FICHIER SELECTIONNE!!!!!")
Exit Sub
End If
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
'dico2 pour comparaison enregistrement(s) en trop(s) fichier1
With Worksheets("Export")
derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID2 = .Range("A2:A" & derlig2)
For Each cel In Plage_ID2
If Not Dico2.exists(cel.Value) Then
Dico2.Add cel.Value, cel.Value
End If
Next cel
End With
'ouverture fichier1.xls
Set fichier1 = Workbooks.Open(Fichier_Ouvrir)
With Workbooks(nom_Fichier).Worksheets("Export")
lig = 2
Do While .Cells(lig, 1) <> ""
If Not Dico2.exists(Cells(lig, 1).Value) Then
'suppression ligne
.Rows(lig).Delete
Else
lig = lig + 1
End If
Loop
'Dico pour ajout enregistrement manquant fichier1 dans fichier2
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID1 = .Range("A2:A" & derlig1)
For Each cel In Plage_ID1
If Not Dico1.exists(Cells(lig, 1).Value) Then
Dico1.Add cel.Value, cel.Value
End If
Next cel
'boucle pour ajout manquant
For Each cel In Plage_ID2
If Not Dico1.exists(cel.Value) Then
derlig1 = derlig1 + 1
addr = cel.Row
.Range("A" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("C" & addr)
.Range("E" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("D" & addr)
.Range("F" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("E" & addr)
End If
Next cel
End With
Set Dico1 = Nothing
Set Dico2 = Nothing
Workbooks(nom_Fichier).Worksheets("Export").Sort.SortFields.Clear
Workbooks(nom_Fichier).Worksheets("Export").Sort.SortFields.Add Key:=Range("A2:A51") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(nom_Fichier).Worksheets("Export").Sort
.SetRange Range("A1:I51")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Columns("A:A").Select
'With Selection
' .HorizontalAlignment = xlLeft
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
'End With
'Range("E1").Select
'With Selection
' .HorizontalAlignment = xlLeft
' .VerticalAlignment = xlCenter
' .WrapText = True
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
'End With
'Workbooks(nom_Fichier).Save
Application.ScreenUpdating = True
End Sub
Est-ce qu'il y a des choses à changer qui ne seraient pas prises en compte sous seven ??
D'avance merci de vos réponses.
Je ne sais pas si j'écris au bon endroit (macro excel ou bien windows 7).
J'ai créé une macro avec l'aide précieuse de michel_m et f894009 (merci encore) dans la question "Modification d'un tableau à partir de 2 fichiers Excell" en Octobre 2013.
Cette macro marchait à merveille sous windows XP.
Je viens de passer sous Windows 7. La macro tourne (aucun message d'erreur) mais le fichier qui doit être modifié ne l'est pas du tout.
La version d'excell est la même que sous XP (Excel 2010).
Voici la macro en question :
Sub traitement_enregistrementsFLE()
Dim derlig1 As Integer, derlig2 As Integer
Dim Dico1, Dico2, cel, Plage_ID2, Plage_ID1
Dim CeClasseur, Fichier_Ouvrir, nom_Fichier As String
Application.ScreenUpdating = False
CeClasseur = ThisWorkbook.Name
'si repertoire connu
'Chdir="C:\mon_repertoire"
'boite a dialogue
Fichier_Ouvrir = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
'test si fichier choisi
If Fichier_Ouvrir <> False Then
nom_Fichier = Right(Fichier_Ouvrir, Len(Fichier_Ouvrir) - InStrRev(Fichier_Ouvrir, "\"))
Else
MsgBox ("PAS DE FICHIER SELECTIONNE!!!!!")
Exit Sub
End If
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
'dico2 pour comparaison enregistrement(s) en trop(s) fichier1
With Worksheets("Export")
derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID2 = .Range("A2:A" & derlig2)
For Each cel In Plage_ID2
If Not Dico2.exists(cel.Value) Then
Dico2.Add cel.Value, cel.Value
End If
Next cel
End With
'ouverture fichier1.xls
Set fichier1 = Workbooks.Open(Fichier_Ouvrir)
With Workbooks(nom_Fichier).Worksheets("Export")
lig = 2
Do While .Cells(lig, 1) <> ""
If Not Dico2.exists(Cells(lig, 1).Value) Then
'suppression ligne
.Rows(lig).Delete
Else
lig = lig + 1
End If
Loop
'Dico pour ajout enregistrement manquant fichier1 dans fichier2
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID1 = .Range("A2:A" & derlig1)
For Each cel In Plage_ID1
If Not Dico1.exists(Cells(lig, 1).Value) Then
Dico1.Add cel.Value, cel.Value
End If
Next cel
'boucle pour ajout manquant
For Each cel In Plage_ID2
If Not Dico1.exists(cel.Value) Then
derlig1 = derlig1 + 1
addr = cel.Row
.Range("A" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("C" & addr)
.Range("E" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("D" & addr)
.Range("F" & derlig1) = Workbooks("Export_HPOV_FLEURY.xls").Worksheets("Export").Range("E" & addr)
End If
Next cel
End With
Set Dico1 = Nothing
Set Dico2 = Nothing
Workbooks(nom_Fichier).Worksheets("Export").Sort.SortFields.Clear
Workbooks(nom_Fichier).Worksheets("Export").Sort.SortFields.Add Key:=Range("A2:A51") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(nom_Fichier).Worksheets("Export").Sort
.SetRange Range("A1:I51")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Columns("A:A").Select
'With Selection
' .HorizontalAlignment = xlLeft
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
'End With
'Range("E1").Select
'With Selection
' .HorizontalAlignment = xlLeft
' .VerticalAlignment = xlCenter
' .WrapText = True
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
'End With
'Workbooks(nom_Fichier).Save
Application.ScreenUpdating = True
End Sub
Est-ce qu'il y a des choses à changer qui ne seraient pas prises en compte sous seven ??
D'avance merci de vos réponses.
A voir également:
- Macro excel fonctionne sous xp mais pas sous seven
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Cle windows xp - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide