suppression de lignes sous vba

Question

Bonjour,
je suis débutant en vba,
je cherche à supprimer des lignes dont les fichiers ont une extension "doc".
voici mon bout de code:
j'utilise une boucle de lecture des fichiers, si je tombe sur un fichier dont l'extension est .doc je ne l'affiche pas. ça c'est fait, par contre le résultat me laisse des lignes blanches.  


For ICollec = 1 To eCollectionFichier.Count
    
        Set FichierCourant = eCollectionFichier.Item(ICollec)
        
        Dim oFSO As Scripting.FileSystemObject
        Dim ext As String
        Dim sSource As String
        sSource = Range("RG_CHEMIN_DOSSIER")
        
        'Instanciation du FSO
        Set oFSO = New Scripting.FileSystemObject
        ext = oFSO.GetExtensionName(FichierCourant.Nom)

If ext <> "doc" Then
            
             RgDeb.Offset(ICollec, COL_FICH_NOM) = FichierCourant.Nom
Next

quelqu'un peut il m'aider?

ucfoutu · Answer

Bonjour,
Question de logique !
Tes lignes blanches proviennent de manière très manifeste de ce que Icollec continue d'avancer comme un grand, de son côté.
La solution est évidente : un compteur (disons toto) que tu n'incrémentes dans ta boucle que si ext <> "doc". et c'est ensuite toto et non Icollec, que tu dois utiliser en Offset !



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

alade23 · Answer

Je te remercie pour ton aide. j'ai déclaré un compteur compt pour l'affichage des fichiers non .doc, que j'incrémente que si ext<> doc.ça ne marche pas; dois imbriquer une autre boucle for avec toto comme variable dans la première de parametre ICollec? For ICollec = 1 To eCollectionFichier.Count Set FichierCourant = eCollectionFichier.Item(ICollec) Dim oFSO As Scripting.FileSystemObject Dim ext As String Dim sSource As String sSource = Range("RG_CHEMIN_DOSSIER") 'Instanciation du FSO Set oFSO = New Scripting.FileSystemObject ext = oFSO.GetExtensionName(FichierCourant.Nom) Dim compt as integer compt = 1 If ext <> "doc" Then RgDeb.Offset(compt, COL_FICH_NOM) = FichierCourant.Nom compt = compt + 1 Next Merci

ucfoutu · Answer

C'est une plaisanterie ou tu n'es pas réveillé ?
Regarde ce que tu as fait : tu remets compt à 1 à l'intérieur de ta boucle 
Tu m'étonnes, tiens !
Ces deux lignes :
Dim compt as integer
compt = 1 
doivent bien évidemment être écrites avant la boucle for et non en son sein !:!!

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

alade23 · Answer

Merci pour ton aide, et pour ta réactivité;-)
j'ai un autre souci avec le bouton supprimer qui est censé effacer toutes les liens de ma macros aprés un double clic sur celui ci.un double clic appelle une fonction supprimerfichier créé.ça marche pas.

Sub SupprimerFichier()
    
    Dim iLine As Integer
    Dim fic As FileSystemObject
    Dim ficfolder  As Folder, ficFile  As File, fCheminDossier As String, fDestinationDossier As String, fDestinationFolder As Folder
    iLine = 1
    Set RgDeb = Range("RG_DEBTAB")
    Set fic = New FileSystemObject
    
    OffsetAllDebRow = RgDeb.Row - BtSelect.Row
    
    
                                        
    Do Until RgDeb.Offset(iLine, 0) = ""
    
        If BtSelect.Offset(iLine + OffsetAllDebRow, 0) = ACTIONTAG Then
        
            fCheminDossier = RgDeb.Offset(iLine, COL_FICH_CHEMIN)
            
            If fic.FileExists(fCheminDossier) = True Then
                
                On Error GoTo ActionNonEffectue
                
                Set ficFile  = fic.GetFile(fCheminDossier)
                
                ficFile .Delete
                BtSelect.Offset(iLine + OffsetAllDebRow, 0) = DELETEDTAG
                BtSelect.Offset(iLine + OffsetAllDebRow, 0).Font.Color = vbGreen

            
            Else
            
ActionNonEffectue:
                BtSelect.Offset(iLine + OffsetAllDebRow, 0) = NOACTIONDONETAG
                BtSelect.Offset(iLine + OffsetAllDebRow, 0).Font.Color = vbRed

            End If
            
        End If
        
        iLine = iLine + 1
        
    Loop
    
End Sub

ucfoutu · Answer

- Si le problème objet de la présente discussion est résolu ===>> un clic sur le tag "réponse acceptée" au niveau du message qui a permis la résolution.
- si tu as une autre difficulté ===>> ouvre une autre discussion
C'est la base du fonctionnement de ce forum : une seule difficulté spécufique et isolée par discussion.



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Suppression de lignes sous vba

5 réponses

Votre réponse

Discussions similaires