End if sans bloc ifRésolu

Question

Bonjour à toutes et tous, 

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)


       objExcel.DisplayAlerts = False 'enlève l'alerte
       objExcel.Application.Visible = False
       
    ' 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"
               
        objExcel.ActiveWorkbook.Sheets("OUT").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

mortalino · Accepted Answer

Arf, pas testé, je l'ai fait à l'oeil :

        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>

B0mbJacK · Answer

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)

       objExcel.DisplayAlerts = False 'enlève l'alerte
       objExcel.Application.Visible = False
       
    ' 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"
               
        objExcel.ActiveWorkbook.Sheets("OUT").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

cs_casy · Answer

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"
               
    objExcel.ActiveWorkbook.Sheets("OUT").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 #

cs_casy · Answer

Et au passage, il va te manquer un Next aussi, si je me suis pas tromper.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

B0mbJacK · Answer

re, 
y'a 2 boucle pour un seul next aussi

B0mbJacK · Answer

j'aurai du faire un refresh avant ....,désolé

mortalino · Answer

Salut, voici le code en couleur : 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) objExcel.DisplayAlerts = False 'enlève l'alerte objExcel.Application.Visible = False ' 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" objExcel.ActiveWorkbook.Sheets("OUT").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) Coloration syntaxique automatique [mortalino] @++

--Mortalino-- Le mystérieux chevalier, "Provençal, le Gaulois" /DIV>

cs_casy · Answer

Marche ton code mortalino

Tu as toujours le If Inline et donc le End If perdu ton seul à la fin du bloc For.

enfin non il est pas tout seul, il est accompagné du message d'erreur 

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

jeanluc065 · Answer

Bonjour à toutes et tous,


Merci à Mortalino et Casy pour l'aide apportée , çà tourne au poil.
Bon dimanche à vous deux
JL

End if sans bloc if

9 réponses

Votre réponse

Discussions similaires