Problème fermeture excel

N

Nicolas

Guest
Bonjour à tous,

J'essaie de charger des fichiers excel avec une macro depuis acces
le premier chargement se passe bien
dès que j essaie d'en faire un deuxieme a la suite, ca plante et j ai remarqué qu'il restait un processus excel ouvert
Pourtant je crois avoir bien fermé l'appli dans la macro

Si je charge un fichier apres je ferme access et je recommence ca marche
mais dès que j essaie d'en charger deux à la suite le deuxieme et tous les suivants ne fonctionnent pas
j ai beau cherché mais je ne trouve pas
Merci d'avance des conseils que vous pourrez m apporter
voici le code :

Private Sub Commande0_Click()

On Error GoTo Err_Excel_ALmmande


Dim mysheet As Object
Dim xlApp As Object
Dim plage As Object




Dim dbsFDI As Database
Dim rst As Recordset
Dim strSQL As String

Dim matuser, NomUser, Nomfile, Préfixe, SemaineFile, AnneeFile, FichierComplet As String
Dim Num_FDI, TypeFDI, Activite As String
Dim Charge As Single
Dim longeur, Position, Index, NombredeligneAlire, I As Integer
Dim occurence_AL(7)
Dim tableau_AL()
Dim occurence_PR(4) As Variant
Dim tableau_PR()

Set xlApp = CreateObject("Excel.Application")

' Recherche du fichier à lire
Index = Me.ListBoxFichier.ListIndex
Nomfile = Me.ListBoxFichier.List(Index)
Chemin = Me.Chemin


'Quel type de fichier AL ou PR ?
'AL = Chargement de la table Alocation (ALO = Passé
'PR chargement de la table CAL pour Calendrier = Prévision de présence
Préfixe = Left(Nomfile, 2)
Select Case Préfixe

Case "AL"

'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 9, Position - 9)
occurence_AL(0) = matuser
AnneeFile = Mid(Nomfile, 6, 2)
occurence_AL(1) = AnneeFile
SemaineFile = Mid(Nomfile, 4, 2)
occurence_AL(2) = SemaineFile
'Vérifier si le salarié existe

Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)

If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
Exit Sub

Else
NomUser = rst!EQP_NOM
rst.CLOSE

End If

FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)

'Selection de la première feuille
'mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select
Set plage = ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count


'Lecture des lignes
'
For I = 2 To NombredeligneAlire
TypeFDI = Cells(I, 1).Value
occurence_AL(4) = TypeFDI
Num_FDI = Cells(I, 2).Value
occurence_AL(3) = Num_FDI
Activite = Cells(I, 3).Value
occurence_AL(5) = Activite
Charge = Cells(I, 4).Value
occurence_AL(6) = Charge
ReDim Preserve tableau_AL(I - 2)
tableau_AL(I - 2) = occurence_AL
Next



For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO ALO "
strSQL = strSQL & "(ALO_MAT, ALO_YEA, ALO_SEM, ALO_ACT, ALO_NUM, ALO_TYP,ALO_CHG )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_AL(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'20" & tableau_AL(I - 2)(1) & "' ," 'AnneeFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(2) & "' ," 'SemaineFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(5) & "' ," 'Activite
strSQL = strSQL & "'" & tableau_AL(I - 2)(3) & "' ," 'Num_FDI
strSQL = strSQL & "'" & tableau_AL(I - 2)(4) & "' , " 'TypeFDI
strSQL = strSQL & Chr(34) & tableau_AL(I - 2)(6) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next

MsgBox ("Chargement terminé")


Case "PR"

'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 4, Position - 4)
occurence_PR(0) = matuser

'Vérifier si le salarié existe

Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)

If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
xlApp.Quit
Exit Sub
Else
NomUser = rst!EQP_NOM
rst.CLOSE
End If

FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)

'Selection de la première feuille
mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select

'mysheet.Sheets("Feuil1").Range("A1").Activate
'ActiveCell.CurrentRegion.Select

plage = mysheet.ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count


'Lecture des lignes
'
For I = 2 To NombredeligneAlire
Date = Cells(I, 1).Value
occurence_PR(1) = Date
Activite = Cells(I, 2).Value
occurence_PR(2) = Activite
Charge = Cells(I, 3).Value
occurence_PR(3) = Charge
ReDim Preserve tableau_PR(I - 2)
tableau_PR(I - 2) = occurence_PR
Next

For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO CAL "
strSQL = strSQL & "(CAL_MAT, CAL_DT, CAL_TYP_OCC, CAL_CHA )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_PR(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'" & tableau_PR(I - 2)(1) & "' ," 'Date
strSQL = strSQL & "'" & tableau_PR(I - 2)(2) & "' ," 'Activite
strSQL = strSQL & Chr(34) & tableau_PR(I - 2)(3) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next

MsgBox ("Chargement terminé")

End Select




'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE

'Commande:

xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing
Exit Sub

Err_Excel_ALmmande:
'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE

MsgBox Err.Description
xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing


End Sub
 

Discussions similaires

Réponses
2
Affichages
334
Réponses
1
Affichages
207

Statistiques des forums

Discussions
312 677
Messages
2 090 807
Membres
104 671
dernier inscrit
Guilbry