[VB.Excel] Supprimer feuilles inactives
Résolu
ProMed1
Messages postés
33
Statut
Membre
-
ProMed1 Messages postés 33 Statut Membre -
ProMed1 Messages postés 33 Statut Membre -
bonjour,
J'ai un dossier (consolider) qui comporte que des fichier Excel
Mon bute est de supprimer toutes les feuilles inactive de toutes les classeur qui se trouve dans mon dossier (consolider).
ici bas mon code VB, vu que je suis débutant malheureusement ça marche plus
merci d'avance pour vos aides
J'ai un dossier (consolider) qui comporte que des fichier Excel
Mon bute est de supprimer toutes les feuilles inactive de toutes les classeur qui se trouve dans mon dossier (consolider).
ici bas mon code VB, vu que je suis débutant malheureusement ça marche plus
merci d'avance pour vos aides
Option Explicit
Dim NomClasseur As String
Dim WS As Worksheet
Sub SupWS()
ChDir "C:\Users\User\Desktop\consolider"
NomClasseur = Dir("C:\Users\User\Desktop\consolider\*.xlsx")
While Len(NomClasseur) > 0
Workbooks.Open NomClasseur
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> ThisWorkbook.ActiveSheet.Name Then
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True
End If
Next WS
Workbooks(NomClasseur).Save
Workbooks(NomClasseur).Close
NomClasseur = Dir
Wend
MsgBox "le traitement est terminer..."
End Sub
| EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages. |
2 réponses
-
Bonjour,
Cette feuille active est la meme dans tous les clsseurs????-
-
-
Bonjour,
En effet j'arrive pas à atteindre mon objectif, à savoir supprimer les feuilles inactives de toutes les classeurs.
Les modifications s'appliquent sur mon fichier (.xlsm) et non pas aux autres classeurs (.xlsx), qui s'ouvrent et se ferment sants modifications.
Merci d'avance pour votre aide. -
-
-
-
Bonjour,
un exemple de code avec recherche chemin du Bureau
Sub Sup_WS() Dim Date_in As String, Date_Choix As Date Dim Fichier As String, Chemin_Bureau As String, MsgGP As String, TitleMsg As String Application.ScreenUpdating = False 'fige ecran 'recherche du chemin du Bureau Chemin_Bureau = ObtenirCheminBureau() & "\consolider\" 'recherche fichiers NbF = 0 NomClasseur = Dir(Chemin_Bureau & "*.xlsx") 'Boucle sur les fichiers While NomClasseur <> "" Call Traitement(Chemin_Bureau & NomClasseur, NomClasseur) NbF = NbF + 1 NomClasseur = Dir() 'fichier suivant Wend MsgBox "[ " & NbF & " ] Fichier(s) recupere(s)" Application.ScreenUpdating = True 'defige ecran End Sub 'Traitement suppression feuilles Sub Traitement(Chemin_Bureau_Fichier, Fichier) Dim WS As Worksheet Workbooks.Open Chemin_Bureau_Fichier For Each WS In Worksheets If WS.Name <> ActiveSheet.Name Then Application.DisplayAlerts = False WS.Delete Application.DisplayAlerts = True End If Next WS Workbooks(Fichier).Close True End Sub-
bonjour,
Problème résolu. Merci pour toutes tes éclaircissement, résultats étonnants.
juste pour info, au début j'ai un petit problème de débogage avec votre Code, mais j'ai remplacer votre instruction n°7 par: ChDir "C:\Users\User\Desktop\consolider" et c'est parfait. -
Bonjour,
C'est moi qui ai merde, j'ai oublie la fonction recherche bureau
Public Function ObtenirCheminBureau() As String 'par: Excel-Malin.com ( http://excel-malin.com ) On Error GoTo ObtenirCheminBureauError Dim CheminBureau As String CheminBureau = "" Dim oWSHShell As Object Set oWSHShell = CreateObject("WScript.Shell") CheminBureau = oWSHShell.SpecialFolders("Desktop") If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing ObtenirCheminBureau = CheminBureau Exit Function ObtenirCheminBureauError: If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing ObtenirCheminBureau = "" End Function -
-
