For avec 2 conditions

Le 19/12/2018 à 15:31

Bonjour à tous ,

J'ai une macro qui ouvre des fichiers et supprime, soit la 2è ou la 3è feuille de chaque fichier enregistré dans un répertoire “J9”.

Avant la macro fonctionnait bien avec la 1è condition. Lorsque j'ai ajouté la 2è condition (VBA ci-dessous) la macro a cessé de fonctionner. (ci-joint une capture d’écran du message d'erreur).

J’ai essayé plusieurs exemple de VBA, mais sans succès.

Si vous me permettez, je vous transmets le VBA en question.

En vous souhaitant une bonne réception.

Cher internaute, je vous remercie à l'avance pour votre aide .

Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)

For i = 10 To lastrow

'1ère condition:
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "RESEAU" Then

  For Each objFile In objFolder.Files

   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name

      Application.DisplayAlerts = False

            Workbooks(wb2).Sheets(3).Delete
                Workbooks(wb2).Save
                    Workbooks(wb2).Close

'2ème Condition: (que j'ai ajouté)
ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") <> "RESEAU" Then

   For Each objFile In objFolder.Files

   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name

      Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete
                Workbooks(wb2).Save
                     Workbooks(wb2).Close

   End If
  Next objFile
End If

Next i

nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")
   MsgBox ("TERMINÉ : " & nombre & " ONGLETS EFFECES")

End Sub
sans titre
Le 19/12/2018 à 16:17

Bonjour,

Tu parcours utilise une même variable pour chacune de tes boucles, mais la seconde est imbriquée dans la première donc ça conduit nécessairement à une erreur. Je n'ai pas du tout regardé le détail de ton code, il est surement possible de faire autrement, mais ton problème serait résolu si dans ta seconde boucle tu utilises un nom différent de la première, par exemple : objFile2 à la place d'une réutilisation de objFile.

Edit : l'une de tes 2 boucles n'a pas d'instruction de fin (Next). Si la fin de la première boucle s'arrête avant le début de la seconde, tu peux conserver la même variable.

Le 19/12/2018 à 18:45

Bonsoir Pedro22,

Suite à vos remarques, j'ai d'abord déclaré et ajouté objFile2 dans la 2è condition.

Dim objFile, objFile2 As Object

Par contre, lorsque j’exécute la macro, Excel m'affiche un message d'erreur, a priori le problème vient de "next i" (ci joint la capture d'écran).

Est ce que vous avez une idée de ce que je dois modifier pour résoudre ce soucis SVP ?

Merci d'avance.

capture
Le 19/12/2018 à 19:13

bonsoir las-dias

il serait bien facile de enlever la 2eme condition ce qui nous ramenez au premier macro fonctionnel, puis nous continuons

Le 19/12/2018 à 19:56

Bonsoir à tous,

Amir la 2è condition est nécessaire.

Solution trouvée

manque 2 syntaxes à la fin du code de la 1ère boucle.

End If
  Next objFile

Bonne soirée.

Le 19/12/2018 à 20:17

Dernière question, je souhaite savoir est ce qu'il existe une ligne de code pour COMPTER le nombre des fichiers traités dans la boucle pour les 2 conditions.

Dans le code, j'ai mis : nombre = WorksheetFunction.CountIf(Range("G:G"), "OUI")

Mais ça ne compte pas le nombre réel des fichiers traités dans la boucle.

Est ce que vous avez une idée SVP ?

Merci encore pour votre aide.

Le 19/12/2018 à 21:08

bonsoir

regardez ça

Sub DELETE_SHEETS()

lastrow = Range("G" & Rows.Count).End(xlUp).Row
Wb = ThisWorkbook.Name
Dim objFolder As Object
Dim objFile As Object
Dim chemin As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
chemin = Workbooks(Wb).Sheets("PARAMETRES").Cells(9, "J")
Set objFolder = objFSO.GetFolder(chemin)
'----------##########----------
cntr0 = 0
cntr1 = 0
'----------##########----------

For i = 10 To lastrow

'1ère condition:
If Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") = "RESEAU" Then

  For Each objFile In objFolder.Files

   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name

      Application.DisplayAlerts = False

            Workbooks(wb2).Sheets(3).Delete
                Workbooks(wb2).Save
                    Workbooks(wb2).Close
   '----------##########----------
   cntr0 = cntr0 + 1
   '----------##########----------

   End If
 Next objFile

'2ème Condition: (que j'ai ajouté)
ElseIf Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "G") = "OUI" And Workbooks(Wb).Sheets("PARAMETRES").Cells(i, "A") <> "RESEAU" Then

   For Each objFile In objFolder.Files

   If InStr(objFile.Name, Sheets("PARAMETRES").Cells(i, "B")) <> 0 Then
     LienFichier = chemin & "\" & objFile.Name
     ActiveWorkbook.FollowHyperlink Address:=(LienFichier)
     wb2 = objFile.Name

      Application.DisplayAlerts = False
            Workbooks(wb2).Sheets(2).Delete
                Workbooks(wb2).Save
                     Workbooks(wb2).Close
   '----------##########----------
   cntr1 = cntr1 + 1
   '----------##########----------

   End If
  Next objFile
End If

Next i

MsgBox ("TERMINÉ0 : " & cntr0 & "TERMINÉ1 : " & cntr1 & "Total : " & cntr0 + cntr1) 'A modifier il compte les cas positive
End Sub
Le 19/12/2018 à 22:19

Oui j'ai inclus votre VBA et ça a bien fonctionné ensuite, je vous remercie.

Si vous me permettez, je voudrais profiter toujours de l'occasion , j'ai une autre macro avec laquelle j'ai essayé à plusieurs reprises de faire la même choses, sans succès (compter le nombre du traitement dans la boucle).

J'ai essayé l'expression suivante, mais ça m'affiche un nombre bien supérieur au nombre traité.

MsgBox ("TERMINÉ : " & no_metier & " fichiers créés !")

Je vous la transmets si vous voulez bien accepter de la revoir s'il vous plait.

Sub CREATION_N_FICHIER()
Dim no_fichier As Integer
no_fichier = 1

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9
Do While no_fichier< derfichier + 1
If Range("G" & no_metier + 9).Value = "OUI" Then

    Range("B1").Value = Range("B" & no_metier + 9).Value
    Range("C1").Value = Range("C" & no_metier + 9).Value
    Range("D1").Value = Range("D" & no_metier + 9).Value

    Sheets(2).Name = Worksheets("PARA").Range("B1").Value

    chemin = Range("F3").Value & "\"
    strfichier = chemin & " - " & Range("B1").Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8
   End If
    no_fichier= no_fichier+ 1

Loop

MsgBox (no_metier & " fichiers créés !")
End Sub
Le 21/12/2018 à 18:23

bonsoir las-dias

Veuillez m'excuser pour ce retard, je viens juste ouvrir mon compte.

Je ne comprends pas comment s incrémente cette variable no_metier pour If Range("G" & no_metier + 9).Value = "OUI" Then

et aussi MsgBox (no_metier & " fichiers créés !")

regardez si fonctionne :

Sub CREATION_N_FICHIER()
Dim no_fichier As Integer
no_fichier = 1

'----------##########----------
cntr = 0
'----------##########----------

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9

Do While no_fichier < derfichier + 1 '

    '----------##########----------
    cntr = cntr + 1
    '----------##########----------

    If Range("G" & no_metier + 9).Value = "OUI" Then

       Range("B1").Value = Range("B" & no_metier + 9).Value
       Range("C1").Value = Range("C" & no_metier + 9).Value
       Range("D1").Value = Range("D" & no_metier + 9).Value

       Sheets(2).Name = Worksheets("PARA").Range("B1").Value

       chemin = Range("F3").Value & "\"
       strfichier = chemin & " - " & Range("B1").Value & ".xls"
        ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8

       '----------##########----------
       no_fichier = no_fichier + 1
       '----------##########----------
    End If

    '----------##########----------
    If cntr = derfichier Then Exit Do ' a ajuster
    '----------##########----------
Loop

    '----------##########----------
    MsgBox (no_fichier & " fichiers créés !")
    '----------##########----------

    '(MsgBox (no_metier & " fichiers créés !")
End Sub

je pense que vous pouvez utiliser l’instruction For...Next comme ca :

Sub CREATION_N_FICHIER()
Dim no_fichier As Integer
no_fichier = 0

strCheminSource = ActiveWorkbook.FullName
lder = ThisWorkbook.Worksheets("PARA").Range("B" & Application.Rows.Count).End(xlUp).Row

derfichier = lder - 9

For i = 0 To derfichier ' a ajuster

    If Range("G" & no_metier + 9).Value = "OUI" Then

       Range("B1").Value = Range("B" & no_metier + 9).Value
       Range("C1").Value = Range("C" & no_metier + 9).Value
       Range("D1").Value = Range("D" & no_metier + 9).Value

       Sheets(2).Name = Worksheets("PARA").Range("B1").Value

       chemin = Range("F3").Value & "\"
       strfichier = chemin & " - " & Range("B1").Value & ".xls"
        ActiveWorkbook.SaveAs Filename:=strfichier, FileFormat:=xlExcel8

       '----------##########----------
       no_fichier = no_fichier + 1
       '----------##########----------

    End If
Next
    '----------##########----------
    MsgBox (no_fichier & " fichiers créés !")
    '----------##########----------

    '(MsgBox (no_metier & " fichiers créés !")
End Sub
Le 22/12/2018 à 16:15

Bonjour,

Je vous remercie pour votre réponse, j'ai essayé votre VBA mais ça n'a pas marché.

Faut-il pas mettre quelque chose (variable) devant "NEXT ..." ? puis ensuite "End if" après ?

Le 22/12/2018 à 17:06

Bonjour las-dias

Sincèrement sans un fichier exemple je ne peux pas te dire exactement quoi faire, tu peux créer un fichier model en piece joint (exemple avec quelque chose qui rassemble à ton travail) et on verra après .

Rechercher des sujets similaires à "conditions"