OVH Cloud OVH Cloud

HELP : Pb bloquant: fermeture Excel

1 réponse
Avatar
nmotte
Bonjour à tous,

J'essaie de charger avec une macro access des infos à partir de
fichiers Excel
Le premier chargement sse passe bien mais si j essaie de charger un
deuxieme à la suite, une erreur apparait.
j'ai beau chercher je ne trouve pas d'ou cela provient.
Je pense que c est un problème d'initialisation...
Qualqu'un dans le forum demandait si il y a avit un exit sub dans la
macro pour un problème analogue. c est mon cas mais je ne vois pas ce
que cela change
Voici le code et merci d'avance pour vos conseils :

Option Compare Database
Option Explicit


Private Sub Commande0_Click()

On Error GoTo Err_Excel_ALmmande

Dim dbsFDI As Database
Dim rst As Recordset
Dim strSQL As String
Dim mysheet As Object
Dim xlApp As Object
Dim plage As Object
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
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 = 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
Exit Sub

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

MsgBox Err.Description
xlApp.Quit


End Sub

1 réponse

Avatar
Rv
Salut,

Avant chaque exit sub et à la fin de la procédure et dans la gestion
d'erreur :
xlapp.quit
set xlapp = nothing

A+

Rv


"NiKo" a écrit dans le message de
news:
Bonjour à tous,

J'essaie de charger avec une macro access des infos à partir de
fichiers Excel
Le premier chargement sse passe bien mais si j essaie de charger un
deuxieme à la suite, une erreur apparait.
j'ai beau chercher je ne trouve pas d'ou cela provient.
Je pense que c est un problème d'initialisation...
Qualqu'un dans le forum demandait si il y a avit un exit sub dans la
macro pour un problème analogue. c est mon cas mais je ne vois pas ce
que cela change
Voici le code et merci d'avance pour vos conseils :

Option Compare Database
Option Explicit


Private Sub Commande0_Click()

On Error GoTo Err_Excel_ALmmande

Dim dbsFDI As Database
Dim rst As Recordset
Dim strSQL As String
Dim mysheet As Object
Dim xlApp As Object
Dim plage As Object
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
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 = 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
Exit Sub

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

MsgBox Err.Description
xlApp.Quit


End Sub