End if sans bloc if [Résolu]

Question

End if sans bloc if [Résolu]

Signaler

jeanluc065

Messages postés: 134
Date d'inscription: samedi 23 septembre 2006
Statut: Membre
Dernière intervention: 1 juin 2007

- 21 oct. 2006 à 15:16
jeanluc065

Messages postés: 134
Date d'inscription: samedi 23 septembre 2006
Statut: Membre
Dernière intervention: 1 juin 2007

- 22 oct. 2006 à 08:22

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

A voir également:

End if sans bloc if
End If sans bloc If, VBA/Access ✓ - Forum - Visual Basic
Visual basic end if - Conseils pratiques - Visual Basic / VB.NET
Probleme end if ✓ - Forum - Visual Basic 6
If/End If ✓ - Forum - Visual Basic 6
Probleme End if ✓ - Forum - Visual Basic

9 réponses

Réponse 2 / 9

B0mbJacK

Messages postés: 141
Date d'inscription: lundi 23 février 2004
Statut: Membre
Dernière intervention: 25 octobre 2006

21 oct. 2006 à 15:22

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

Réponse 3 / 9

cs_casy

Messages postés: 7741
Date d'inscription: mercredi 1 septembre 2004
Statut: Membre
Dernière intervention: 24 septembre 2014

37
21 oct. 2006 à 15:28

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 #

Réponse 4 / 9

cs_casy

Messages postés: 7741
Date d'inscription: mercredi 1 septembre 2004
Statut: Membre
Dernière intervention: 24 septembre 2014

37
21 oct. 2006 à 15:31

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 #

Réponse 5 / 9

B0mbJacK

Messages postés: 141
Date d'inscription: lundi 23 février 2004
Statut: Membre
Dernière intervention: 25 octobre 2006

21 oct. 2006 à 15:32

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

Réponse 6 / 9

B0mbJacK

Messages postés: 141
Date d'inscription: lundi 23 février 2004
Statut: Membre
Dernière intervention: 25 octobre 2006

21 oct. 2006 à 15:33

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

Réponse 7 / 9

mortalino

Messages postés: 6786
Date d'inscription: vendredi 16 décembre 2005
Statut: Membre
Dernière intervention: 21 décembre 2011

18
21 oct. 2006 à 23:00

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>

Réponse 8 / 9

cs_casy

Messages postés: 7741
Date d'inscription: mercredi 1 septembre 2004
Statut: Membre
Dernière intervention: 24 septembre 2014

37
21 oct. 2006 à 23:06

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 #

Réponse 9 / 9

jeanluc065

Messages postés: 134
Date d'inscription: samedi 23 septembre 2006
Statut: Membre
Dernière intervention: 1 juin 2007

22 oct. 2006 à 08:22

Bonjour à toutes et tous,

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

Répondre Posez votre question

mortalino · Accepted Answer · 2006-10-21T23:13:40+0200

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>

Votre réponse