Salut à Tous, J'ai crée une appli en 2004 pour mettre automatiquement un Cartouche sur un plan et enregsitrer ce plan qq part. sur Autocad 2004, pas de probleme, mais depuis çà cagouille!! Je suis actuellement en 2009. cas 1 : Je pars d'un nouveau plan, je clique sur mon petit bouton, et hop AUCUN problèmes. Depuis ce nouveau plan, je clique à nouveau sur mon p"tit bouton et hop, çà foire !!. cas 2 : Je pars d'un nouveau plan, je clique sur mon petit bouton, et hop AUCUN problèmes. Je ferme Autocad, puis réouvre le dernier plan ( celui qui vient d^'étre crée) je clique à nouveau sur mon p"tit bouton AUCUN problème. Depuis ce nouveau plan, je clique à nouveau sur mon p"tit bouton et hop, çà foire !!. Comprends pas pourquoi un coup çà marche, et le coup d'après çà plante !! Donc en fait à chaque fois, si je pense bien à refermer Autocad avant de me reservir de cette Appli, pas de problème, mais comme à chaque fois j'oubli.... ca me saoule. J'ai cherché à fond sur Internet et fait une batterie de test et de correction, mais rien n'y fait .... alors A L'AIDE !!!!!!!!!!!!!! Message d'erreur renvoyé: "erreur dexecution'-2145356445 (80200033) - Erreur de fichier Voici la ligne qui est pointée: Set objCartouche = MECA.Block.InsertBlock(PtInsert, "C:\Cartouches\Cartouches.dwg", 1, 1, 1, 0) Voici le code : Dim objCartouche As AcadBlockReference Dim PtInsert(0 To 2) As Double Dim CalCou As String Dim layerObj As Object Dim Curlayer As Object Dim MECA As AcadLayout Dim MecaExist As Boolean PtInsert(0) = 0: PtInsert(1) = 0: PtInsert(2) = 0 ‘--------------------------------------------------------------------------------------------- '------ Supression des cartouches existants présent sur le document ouvert ‘--------------------------------------------------------------------------------------------- ‘---- Supression des cartouches de MODELSPACE For Each elem In ThisDrawing.ModelSpace If elem.EntityType = acBlockReference Then If elem.Name = "Cartouche" Then elem.Delete End If Next ‘---- Supression des cartouches des PAPERSPACE For Each Present In ThisDrawing.Layouts NomPres = Present.Name Set MECA = ThisDrawing.Layouts(NomPres) For Each elem In MECA.Block If elem.EntityType = acBlockReference Then If elem.Name = "Cartouche" Then elem.Delete End If Next Next ‘---- Supression des cartouches de la bibliothèque de bloc du plan ouvert For Each ObjBlo In ThisDrawing.Blocks If ObjBlo.Name = "Cartouche" Then For Each elem In ThisDrawing.Blocks.Item("Cartouche") elem.Delete Next elem End If Next ObjBlo '-------------------------------------------------------- '--Test si une présentation nommée MEP1 existe déjà '-------------------------------------------------------- Set Layouts = ThisDrawing.Layouts MecaExist = False For Each Layout In Layouts If Layout.Name = "MEP1" Then MecaExist = True Next If MecaExist = True Then Set MECA = ThisDrawing.Layouts.Item("MECANOBLOC") If MecaExist = False Then Set MECA = ThisDrawing.Layouts.Add("MECANOBLOC") ThisDrawing.ActiveLayout = MECA '-------------------------------------------------------- '--Insertion du cartouche nouveau cartouche sur « MEP1 » '-------------------------------------------------------- Set objCartouche = MECA.Block.InsertBlock(PtInsert, "C:\Cartouches\Cartouches.dwg", 1, 1, 1, 0) Set dbNumPlan = OpenDatabase("C:\BasedeDonnée\BDDNUMPLAN.mdb") Set NumPlan = dbNumPlan.OpenRecordset("NumPlan-RD", dbOpenDynaset) If Not (NumPlan.EOF And NumPlan.BOF) Then NumPlan.MoveFirst Do Until NumPlan.EOF objCartouche.GetAttributes(0).TextString = NumPlan![Produit] objCartouche.GetAttributes(1).TextString = NumPlan![NomPlan] objCartouche.GetAttributes(2).TextString = NumPlan![NomPlan2] objCartouche.GetAttributes(3).TextString = "0" objCartouche.GetAttributes(58).TextString = NumeroDePlan objCartouche.GetAttributes(59).TextString = "0" Exit Do NumPlan.MoveNext Loop End If dbNumPlan.Close Set dbNumPlan = Nothing Set objCartouche = Nothing Unload Me ThisDrawing.SaveAs cheminplan End Sub