escouger
XLDnaute Occasionnel
Bonjour,
J'ai écrit une macro qui lit plusieurs classeurs un à un, extrait des données de 2 onglets, et les stocke dans un classeur "recap". Après l'extraction du premier classeur lu et avant de lire le suivant je ferme ce premier classeur.
Cela marche parfaitement sur mon PC W7 avec microsoft office 2010.
Sur mon autre PC vista avec MSoffice 2007 je plante sur le "ActiveWorkbook.Close".
Pourriez-vous me dire pourquoi?
Le message est "Excel a cessé de fonctionner...."
Complément: Si je déroule ma macro "pas à pas", le problème n'existe plus!
Voici le code de cette macro:
Sub Import()
Application.ScreenUpdating = False
Worksheets("Benevoles S.").Activate
ActiveSheet.Unprotect
Range("a12:bc20000").Select
Selection.ClearContents
Worksheets("Chefs S.").Activate
ActiveSheet.Unprotect
Range("a12:bc20000").Select
Selection.ClearContents
monfichier = ActiveWorkbook.Name
' Positionnement sur le répertoire par défaut
SetUNCPath "C:\CVS\Sentiers"
'ouverture de la fenetre de selection des fichiers et sauvegarde de leurs noms dans le tableau messources
messources = Application.GetOpenFilename(, , , , True)
SetUNCPath "C:\CVS\Sentiers"
varout = monfichier
'varout = InputBox("Entrer le nom du fichier à générer ", " NOM DU FICHIER ?", , 9400, 1950)
vardir = "C:\CVS\Sentiers"
ChDir (vardir)
ActiveWorkbook.SaveAs Filename:= _
varout, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
'sauvegarde du nom du document actif
'lecture des données du tableau
varadr = "A12"
varlig = 12
ActiveSheet.Unprotect
Application.ScreenUpdating = False
' ______________________________________________________________________________
For i = LBound(messources) To UBound(messources)
'code pour l'import des données
'
Range(varadr).Select
varnam = messources(i)
DisplayAlerts = False
Workbooks.Open Filename:=(varnam)
' Afficher les messages d'alerte
DisplayAlerts = True
Sheets("Chefs S.").Select
Range("a12:bc20000").Select
Selection.Copy
' ne plus afficher les messages d'alerte
Application.DisplayAlerts = False
Workbooks(varout).Activate
ActiveSheet.Unprotect
Sheets("Chefs S.").Visible = True
' ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
' False
Sheets("Chefs S.").Select
' Afficher les messages d'alerte
Application.DisplayAlerts = True
Range(varadr).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' ---------------------------------------------------
mylen = Len(varnam) - 16
varbook = Right(varnam, mylen)
Workbooks(varbook).Activate
Sheets("Benevoles S.").Select
Range("a12:bc20000").Select
Selection.Copy
' ne plus afficher les messages d'alerte
Application.DisplayAlerts = False
Workbooks(varout).Activate
ActiveSheet.Unprotect
Sheets("Benevoles S.").Visible = True
Sheets("Benevoles S.").Select
' Afficher les messages d'alerte
Application.DisplayAlerts = True
varq = "A" & varlig + 200
Range(varq).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'varadr = "d" & varlig
'Range(varadr).Select
'ActiveCell = varnam
' ---------------------------------------------------
varlig = varlig + 400
varadr = "A" & varlig
Range(varadr).Select
'fin du code pour l'import
'suivant
Application.DisplayAlerts = False
Workbooks(varbook).Activate
ActiveWorkbook.Close " PLANTAGE ICI ===============>"
Workbooks(varout).Activate
Application.DisplayAlerts = True
Next i
'________________________________________________________________________
varlig = varlig - 1
RECAPclear
RECAPprepare
DisplayAlerts = True
End Sub
'fonction qui modifie le chemin par défaut
Function SetUNCPath(sPath As String) As Long
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(sPath)
SetUNCPath = lReturn
End Function
J'ai écrit une macro qui lit plusieurs classeurs un à un, extrait des données de 2 onglets, et les stocke dans un classeur "recap". Après l'extraction du premier classeur lu et avant de lire le suivant je ferme ce premier classeur.
Cela marche parfaitement sur mon PC W7 avec microsoft office 2010.
Sur mon autre PC vista avec MSoffice 2007 je plante sur le "ActiveWorkbook.Close".
Pourriez-vous me dire pourquoi?
Le message est "Excel a cessé de fonctionner...."
Complément: Si je déroule ma macro "pas à pas", le problème n'existe plus!
Voici le code de cette macro:
Sub Import()
Application.ScreenUpdating = False
Worksheets("Benevoles S.").Activate
ActiveSheet.Unprotect
Range("a12:bc20000").Select
Selection.ClearContents
Worksheets("Chefs S.").Activate
ActiveSheet.Unprotect
Range("a12:bc20000").Select
Selection.ClearContents
monfichier = ActiveWorkbook.Name
' Positionnement sur le répertoire par défaut
SetUNCPath "C:\CVS\Sentiers"
'ouverture de la fenetre de selection des fichiers et sauvegarde de leurs noms dans le tableau messources
messources = Application.GetOpenFilename(, , , , True)
SetUNCPath "C:\CVS\Sentiers"
varout = monfichier
'varout = InputBox("Entrer le nom du fichier à générer ", " NOM DU FICHIER ?", , 9400, 1950)
vardir = "C:\CVS\Sentiers"
ChDir (vardir)
ActiveWorkbook.SaveAs Filename:= _
varout, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
'sauvegarde du nom du document actif
'lecture des données du tableau
varadr = "A12"
varlig = 12
ActiveSheet.Unprotect
Application.ScreenUpdating = False
' ______________________________________________________________________________
For i = LBound(messources) To UBound(messources)
'code pour l'import des données
'
Range(varadr).Select
varnam = messources(i)
DisplayAlerts = False
Workbooks.Open Filename:=(varnam)
' Afficher les messages d'alerte
DisplayAlerts = True
Sheets("Chefs S.").Select
Range("a12:bc20000").Select
Selection.Copy
' ne plus afficher les messages d'alerte
Application.DisplayAlerts = False
Workbooks(varout).Activate
ActiveSheet.Unprotect
Sheets("Chefs S.").Visible = True
' ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
' False
Sheets("Chefs S.").Select
' Afficher les messages d'alerte
Application.DisplayAlerts = True
Range(varadr).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' ---------------------------------------------------
mylen = Len(varnam) - 16
varbook = Right(varnam, mylen)
Workbooks(varbook).Activate
Sheets("Benevoles S.").Select
Range("a12:bc20000").Select
Selection.Copy
' ne plus afficher les messages d'alerte
Application.DisplayAlerts = False
Workbooks(varout).Activate
ActiveSheet.Unprotect
Sheets("Benevoles S.").Visible = True
Sheets("Benevoles S.").Select
' Afficher les messages d'alerte
Application.DisplayAlerts = True
varq = "A" & varlig + 200
Range(varq).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'varadr = "d" & varlig
'Range(varadr).Select
'ActiveCell = varnam
' ---------------------------------------------------
varlig = varlig + 400
varadr = "A" & varlig
Range(varadr).Select
'fin du code pour l'import
'suivant
Application.DisplayAlerts = False
Workbooks(varbook).Activate
ActiveWorkbook.Close " PLANTAGE ICI ===============>"
Workbooks(varout).Activate
Application.DisplayAlerts = True
Next i
'________________________________________________________________________
varlig = varlig - 1
RECAPclear
RECAPprepare
DisplayAlerts = True
End Sub
'fonction qui modifie le chemin par défaut
Function SetUNCPath(sPath As String) As Long
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(sPath)
SetUNCPath = lReturn
End Function
Dernière édition: