End if sans bloc if [Résolu]

Signaler
Messages postés
134
Date d'inscription
samedi 23 septembre 2006
Statut
Membre
Dernière intervention
1 juin 2007
-
Messages postés
134
Date d'inscription
samedi 23 septembre 2006
Statut
Membre
Dernière intervention
1 juin 2007
-
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

9 réponses

Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
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>
Messages postés
141
Date d'inscription
lundi 23 février 2004
Statut
Membre
Dernière intervention
25 octobre 2006

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
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
37
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 #
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
37
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 #
Messages postés
141
Date d'inscription
lundi 23 février 2004
Statut
Membre
Dernière intervention
25 octobre 2006

re,
y'a 2 boucle pour un seul next aussi
Messages postés
141
Date d'inscription
lundi 23 février 2004
Statut
Membre
Dernière intervention
25 octobre 2006

j'aurai du faire un refresh avant ....,désolé
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
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)

<small>Coloration syntaxique automatique [mortalino] </small>
       

@++

<hr width ="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
37
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 #
Messages postés
134
Date d'inscription
samedi 23 septembre 2006
Statut
Membre
Dernière intervention
1 juin 2007

Bonjour à toutes et tous,


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