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
'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
'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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
'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
'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
'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
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" <nmotte@free.fr> a écrit dans le message de
news:6d525ba3.0402020318.1d55198a@posting.google.com...
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
'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
'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
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
'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
'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