Access plante à l'exécution d'un module code VBA

Access plante à l'exécution d'un module code VBA - VB/VBA/VBS - Programmation

Marsh Posté le 05-08-2013 à 20:45:56    

Bonjour,  
 
j'ai Access 2013 sous Windows 7. Lorsque j'exécute le module 1 de ma base de données, Access plante avec un message d'erreur qui dit Access doit fermer... Or, si la feuille Excel dans lequel le code va chercher des données est ouverte, Access ne plante pas, mais par conséquent n'exécute pas le reste du code; ce qui est normal due à la structure de celui-ci. Je crois donc qu'il y a de quoi dans le code qui fait planter (car j'ai réinstaller Access et essayé la base sur d'autres ordi et ça plante aussi). Pouvez-vous m'aider, je n'arrive pas à pointer le problème. Merci!!  
 
Voici le code :  

Code :
  1. Option Compare Database
  2. Option Explicit
  3. Sub ImportProjets()
  4.     Const cstlngDécalage    As Long = -1
  6.     Dim rsFeuille           As Recordset
  7.     Dim rsProjet            As Recordset
  8.     Dim lngNuméroProjet     As Long
  9.     Dim lngCompte           As Long
  10.     Dim lngCompteLigne      As Long
  11.     If FichierDisponible("\\SRVSID\Gcs\ISO 9001\F-1-1 Liste des projets_complete.xlsm" ) = False Then
  12.         Beep
  13.         MsgBox "La feuille est ouverte par au moins un utilisateur"
  14.         Exit Sub
  15.     End If
  16.    
  17.     With CurrentDb
  18.         Set rsFeuille = .OpenRecordset("Feuil2" )
  19.         Set rsProjet = .OpenRecordset("T_Liste" )
  20.     End With
  22.     rsProjet.Index = "idProjet"
  24.     BeginTrans
  26.     With rsFeuille
  27.         Do Until .EOF
  28.             lngCompteLigne = lngCompteLigne + 1
  29.             lngNuméroProjet = rsFeuille(1 + cstlngDécalage)
  30.             With rsProjet
  31.                 .Seek "=", lngNuméroProjet
  32.                 If .NoMatch = True Then
  33.                     lngCompte = lngCompte + 1
  34.                     .AddNew
  35.                     !idProjet = lngNuméroProjet
  36.                 Else
  37.                     .Edit
  38.                 End If
  39.                 ![NO DE DOSSIER] = rsFeuille(2 + cstlngDécalage)
  40.                 !CD = rsFeuille(3 + cstlngDécalage)
  41.                 ![TITRE DES PROJETS] = rsFeuille(4 + cstlngDécalage)
  42.                 ![TITRE ABRÉGÉ DES PROJETS] = rsFeuille(5 + cstlngDécalage)
  43.                 ![DATE D'OUVERTURE] = rsFeuille(6 + cstlngDécalage)
  44.                 !MotCle01 = rsFeuille(7 + cstlngDécalage)
  45.                 !MotCle02 = rsFeuille(8 + cstlngDécalage)
  46.                 !TitreCourt = rsFeuille(9 + cstlngDécalage)
  47.                 !Discipline = rsFeuille(10 + cstlngDécalage)
  48.                 !VilleRealisation = rsFeuille(11 + cstlngDécalage)
  49.                 !Mandat = rsFeuille(12 + cstlngDécalage)
  50.                 .Update
  51.             End With
  52.             .MoveNext
  53.         Loop
  54.     End With
  56.    If MsgBox(lngCompte & " nouveau(x) projet(s), les ajouter (Non indiqué, mais peut aussi comprendre des modifications dans les noms)?", vbYesNo) = vbYes Then
  57.        CommitTrans
  58.    Else
  59.        Rollback
  60.    End If
  62. End Sub
  64. Function FichierDisponible(prmstrFichier) As Boolean
  65.     Dim lngFichier      As Long
  66.     On Error Resume Next
  67.     lngFichier = FreeFile
  68.     Open prmstrFichier For Binary Lock Read Write As #lngFichier
  69.     If Err.Number Then
  70.         FichierDisponible = False
  71.     Else
  72.         FichierDisponible = True
  73.         Close #lngFichier
  74.     End If
  75.     On Error GoTo 0
  76. End Function

Reply

Marsh Posté le 05-08-2013 à 20:45:56   

Reply

Marsh Posté le 07-08-2013 à 17:19:31    

Je me demandais si de sortir le rapport d'erreur qui se trouve dans l'observateur d'événement de Windows 7, événement 1000, Application Error, pouvait aider à résoudre le problème. Je fouille sur Internet, mais ne trouve tout de même pas la solution...  Voici donc, si quelqu'un s'y connait :  
 
Nom de l’application défaillante MSACCESS.EXE, version : 15.0.4517.1005, horodatage : 0x51b960eb
Nom du module défaillant : ACECORE.DLL, version : 0.0.0.0, horodatage : 0x51a6f604
Code d’exception : 0xc0000005
Décalage d’erreur : 0x000fdbdf
ID du processus défaillant : 0x136c
Heure de début de l’application défaillante : 0x01ce93800d291767
Chemin d’accès de l’application défaillante : C:\Program Files\Microsoft Office 15\Root\Office15\MSACCESS.EXE
Chemin d’accès du module défaillant: C:\Program Files (x86)\Common Files\Microsoft Shared\Office15\ACECORE.DLL
ID de rapport : 5273386b-ff73-11e2-ba85-14dae9e98850

Reply

Marsh Posté le 07-08-2013 à 19:05:46    

Tu as essayé de faire du Pas à Pas sur au moins une boucle ?
 
ça aiderait à savoir à quelle ligne ça plante si c'est lié à un pb de code (faire une boucle complète en pas à pas)
 
Après je ne connais pas très bien "OpenRecordSet" sur une feuille/fichier excel, mais  :
- comment le .OpenRecordSet("Feuil2" ) peut fonctionner sachant que je ne vois pas où tu as ouvert le fichier excel et en quoi il est rattaché à "CurrentDb"
- le critère ".EOF" est-il suffisant comme critère de fin ? Si c'est pas le cas, il peut passer par des cellules vides et donc amener à des plantes (xlsm/Excel 2007/2010/2013 , c'est 2 millions de lignes de tête)
 
En espérant que ça aide

Reply

Marsh Posté le 07-08-2013 à 20:55:49    

Oui, je viens de le faire. (J'ai placé mon curseur sur chacune des ligne et suis allé au menu Débogage / Exécuter jusqu'au curseur.) Ça plante à la ligne 33.  
 
Pour ce qui est de la "Feuil2" d'Excel, je l'ai attaché en cliquant sur Données externes / Excel / Lier à la source de données en créant une table attachée.
 
Pour ce qui est du critère ".EOF" est-il suffisant comme critère de fin?? Je ne sais pas. C'est pas moi qui a 'inventé' le code, mais je apporté des modifications dessus. Je devrais y mettre quoi? Je suis débutante et je ne sais pas quoi ajouter ou enlever...


Message édité par mielanie le 07-08-2013 à 21:04:48
Reply

Marsh Posté le 09-09-2013 à 16:50:53    

Une idée pour résoudre mon problème svp...?

Reply

Marsh Posté le 07-10-2013 à 19:43:54    

Up!... De l'aide svp...

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed