En access 2002, JMO m'avait écrit une fonction qui marche très bien et j'ai essayé de l'adapter mais j'obtiens un message d'erreur ' erreur de complilation End if sans bloc if"
Quelqu'un peut-il m'aider ?
Merci d'avance,
JL
****************************
En fait le chemin est déterminé dans un autre code et il s'agit ici de mettre en forme des feuilles excell de plusieurs fichiers et en boucle.
Function ShowFolderListbelga(path)
'présentation originale: 1 feuille In 1 feuille Out
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers: Set Dossiers = fso.GetFolder(path)
Dim fichiers: Set fichiers = Dossiers.Files
Dim fichier, f, strListe
For Each fichier In fichiers
DoCmd.Hourglass True
Set f = fso.GetFile(fichier)
If fso.GetExtensionName(fichier) = "xls" Then
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application")
Set objClasseur = objExcel.Workbooks.Open(fichier)
' détermine IN OUT
objExcel.ActiveWorkbook.Sheets(1).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(1).Name = "IN"
If objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(1).Name = "OUT"
End If
objExcel.ActiveWorkbook.Sheets(2).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(2).Name = "IN"
If objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(2).Name = "OUT"
End If
'suppression des colonnes vides
Dim LastLine, I
LastLine = objExcel.ActiveSheet.UsedRange.Row - 1
LastLine = LastLine + objExcel.ActiveSheet.UsedRange.Columns.Count
For I = LastLine To 1 Step -1
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then objExcel.Columns(I).Delete
'renomme les colonnes
objExcel.ActiveWorkbook.Sheets("IN").Select
objExcel.Cells(1, 1).Value = "Date Début"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"
objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
C'est ici que çà se plante
End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
DoCmd.Hourglass False
End Function
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(1).Name = "IN"
ElseIf objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(1).Name = "OUT"
End If
je sais que j'ai modifié les deux If en un seul mais ce ne dois pas être ici, plutôt là :
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then objExcel.Columns(I).Delete
faire entrée après Then :
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then
objExcel.Columns(I).Delete
@++
<hr width="100%" size="2" />
--Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
Function ShowFolderListbelga(path)
'présentation originale: 1 feuille In 1 feuille Out
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers: Set Dossiers = fso.GetFolder(path)
Dim fichiers: Set fichiers = Dossiers.Files
Dim fichier, f, strListe
For Each fichier In fichiers
DoCmd.Hourglass True
Set f = fso.GetFile(fichier)
If fso.GetExtensionName(fichier) = "xls" Then
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application")
Set objClasseur = objExcel.Workbooks.Open(fichier)
' détermine IN OUT
objExcel.ActiveWorkbook.Sheets(1).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(1).Name = "IN"
End if
If objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(1).Name = "OUT"
End If
objExcel.ActiveWorkbook.Sheets(2).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(2).Name = "IN"
End if
If objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(2).Name = "OUT"
End If
'suppression des colonnes vides
Dim LastLine, I
LastLine = objExcel.ActiveSheet.UsedRange.Row - 1
LastLine = LastLine + objExcel.ActiveSheet.UsedRange.Columns.Count
For I = LastLine To 1 Step -1
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then
objExcel.Columns(I).Delete
End if
'renomme les colonnes
objExcel.ActiveWorkbook.Sheets("IN").Select
objExcel.Cells(1, 1).Value = "Date Début"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"
objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
Next
End if
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
DoCmd.Hourglass False
End Function
Ben oui dans le code suivant il te manque un bloc IF, tu as le End If pour fermer le bloc mais pas If pour l'ouvrir.
Alors, il y a bien un If, mais tel qu'écrit c'est une instruction Inline qui est autofermante et qui n'a pas besion de End If
Alors à toi de revoir ton code pour savoir si ce If est le début du bloc, dans ce cas il te faut un retour à la ligne immédiatement après le Then. Ou sinon faut virer le End IF
For I = LastLine To 1 Step -1
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then objExcel.Columns(I).Delete
'renomme les colonnes
objExcel.ActiveWorkbook.Sheets("IN").Select
objExcel.Cells(1, 1).Value = "Date Début"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification" objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
End If
Next
---- Sevyc64 (alias Casy) ----<hr size ="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #
Function ShowFolderListbelga(path)
'présentation originale: 1 feuille In 1 feuille Out
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers: Set Dossiers = fso.GetFolder(path)
Dim fichiers: Set fichiers = Dossiers.Files
Dim fichier, f, strListe
' *** toutes tes variables sont de type Variant !
For Each fichier In fichiers
DoCmd.Hourglass True
Set f = fso.GetFile(fichier)
If fso.GetExtensionName(fichier) = "xls" Then
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application")
Set objClasseur = objExcel.Workbooks.Open(fichier)
' détermine IN OUT
objExcel.ActiveWorkbook.Sheets(1).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(1).Name = "IN"
ElseIf objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(1).Name = "OUT"
End If
objExcel.ActiveWorkbook.Sheets(2).Select
If objExcel.Cells(1, 6).Value = "A-Nom" Then
objClasseur.Sheets(2).Name = "IN"
ElseIf objExcel.Cells(1, 6).Value = "B-Nom" Then
objClasseur.Sheets(2).Name = "OUT"
End If
'suppression des colonnes vides
Dim LastLine, I
LastLine = objExcel.ActiveSheet.UsedRange.Row - 1
LastLine = LastLine + objExcel.ActiveSheet.UsedRange.Columns.Count
For I = LastLine To 1 Step -1
If objExcel.Application.WorksheetFunction.CountA(objExcel.Columns(I)) = 0 Then objExcel.Columns(I).Delete
'renomme les colonnes
objExcel.ActiveWorkbook.Sheets("IN").Select
objExcel.Cells(1, 1).Value = "Date Début"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"
objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
'C'est ici que çà se plante
End If
Next I
End If
Next fichier
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
DoCmd.Hourglass False
End Function
' *** pense à faire une bonne déclaration de tes variables, n'oublie pas I,
' que en est une !
' Tu vois l'importance de mettre "en forme" le code (avec tabulation)