Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Code VBA qui fait planter et fermer Access 2013

Aucune réponse
Avatar
Mielanie
Bonjour,

j'ai un problème de taille qui m'empêche de continuer d'utiliser ma base de données et je suis débutante-intermédiaire dans VBA et Access 2013. Le problème est le suivant :

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. J'ai exécuté la fonction Débogage / Exécuter jusqu'au curseur et ça plante à la ligne 33 (IngCompte = lngCompte + 1) Pouvez-vous m'aider, je n'arrive pas à pointer le problème. Sinon, comment réécrire le code différemment pour régler le bog? Ce que je veux faire, c'est importer des données d'un fichier Excel à ma base de données et pouvoir compléter les informations dans ma base de données Access. Merci énormément!!

Voici mon code :

Option Compare Database
Option Explicit
Sub ImportProjets()
Const cstlngDécalage As Long = -1

Dim rsFeuille As Recordset
Dim rsProjet As Recordset
Dim lngNuméroProjet As Long
Dim lngCompte As Long
Dim lngCompteLigne As Long
If FichierDisponible("e;SRVSIDGcsISO 9001F-1-1 Liste des projets_complete.xlsm"e;) = False Then
Beep
MsgBox "e;La feuille est ouverte par au moins un utilisateur"e;
Exit Sub
End If

With CurrentDb
Set rsFeuille = .OpenRecordset("e;Feuil2"e;)
Set rsProjet = .OpenRecordset("e;T_Liste"e;)
End With

rsProjet.Index = "e;idProjet"e;

BeginTrans

With rsFeuille
Do Until .EOF
lngCompteLigne = lngCompteLigne + 1
lngNuméroProjet = rsFeuille(1 + cstlngDécalage)
With rsProjet
.Seek "e;="e;, lngNuméroProjet
If .NoMatch = True Then
lngCompte = lngCompte + 1
.AddNew
!idProjet = lngNuméroProjet
Else
.Edit
End If
![NO DE DOSSIER] = rsFeuille(2 + cstlngDécalage)
!CD = rsFeuille(3 + cstlngDécalage)
![TITRE DES PROJETS] = rsFeuille(4 + cstlngDécalage)
![TITRE ABRÉGÉ DES PROJETS] = rsFeuille(5 + cstlngDécalage)
![DATE D'OUVERTURE] = rsFeuille(6 + cstlngDécalage)
!MotCle01 = rsFeuille(7 + cstlngDécalage)
!MotCle02 = rsFeuille(8 + cstlngDécalage)
!TitreCourt = rsFeuille(9 + cstlngDécalage)
!Discipline = rsFeuille(10 + cstlngDécalage)
!VilleRealisation = rsFeuille(11 + cstlngDécalage)
!Mandat = rsFeuille(12 + cstlngDécalage)
.Update
End With
.MoveNext
Loop
End With

If MsgBox(lngCompte & "e; nouveau(x) projet(s), les ajouter (Non indiqué, mais peut aussi comprendre des modifications dans les noms)?"e;, vbYesNo) = vbYes Then
CommitTrans
Else
Rollback
End If

End Sub

Function FichierDisponible(prmstrFichier) As Boolean
Dim lngFichier As Long
On Error Resume Next
lngFichier = FreeFile
Open prmstrFichier For Binary Lock Read Write As #lngFichier
If Err.Number Then
FichierDisponible = False
Else
FichierDisponible = True
Close #lngFichier
End If
On Error GoTo 0
End Function

Réponses