Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
Vieux 30/06/2009, 19h43   #1
Invité de passage
 
Date d'inscription: juin 2009
Localisation: France
Messages: 2
Par défaut Création d'une nouvelle feuille pour une liste de fichier

Bonjour,

Voici mon problème :

Je voudrais rajouter une feuille dans plusieurs classeur à la suite. J'ai bien réussi à ouvrir les classeurs, mais les feuilles sont crées dans le fichier du lancement de la macro.

Voici le code :

Code :
Sub Workbook_Open()
Dim LstFich, xfile
Application.ScreenUpdating = False
'Ouverture des fichiers
LstFich = Application.GetOpenFilename("Fichiers Excel(*.xls),*.xls", , _
"Sélection des fichiers à convertir", , True) 'true pour une selection multiple
 
If Not IsArray(LstFich) Then Exit Sub
 
For Each xfile In LstFich
    
    Workbooks.Open FileName:=xfile
    On Error Resume Next
    Workbooks(xfile).Activate
    Sheets.Add
    On Error GoTo 0
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
Next xfile
 
ActiveWorkbook.Close
End Sub
 
Si quelqu'un a une solution à me proposer je suis preneur.

Merci.

Dernière modification par Philippe JOCHMANS ; 30/06/2009 à 21h19. Motif: Ajout des balises codes (sélection du code dans la fenêtre de rédaction des messages, puis un clique sur (#), ce n'est pas facultatif
Cedrick est déconnecté   Envoyer un message privé Réponse avec citation
Vieux 01/07/2009, 01h39   #2
Rédacteur/Modérateur
 
Avatar de Antoun
 
Nom : Antoine Dinimant
Date d'inscription: octobre 2006
Localisation: Paris
Âge: 39
Messages: 5 217
Par défaut

en utilisant ActiveWorkbook.Sheets.Add plutôt que Sheets.Add tout court ?
Antoun est actuellement connecté   Envoyer un message privé Réponse avec citation
Vieux 01/07/2009, 10h01   #3
Membre émérite
 
Date d'inscription: juin 2009
Localisation: Lorraine
Messages: 842
Envoyer un message via MSN à fgiambelluco
Par défaut

Bonjour
A la place de :
Code :
    Workbooks(xfile).Activate
    Sheets.Add
    ActiveWorkbook.Save
    ActiveWorkbook.Close
Essaye :
Code :
    Workbooks(xfile).Sheets.Add
      Workbooks(xfile).Close , True

Dernière modification par AlainTech ; 05/07/2009 à 07h41. Motif: Balises [code]
fgiambelluco est déconnecté   Envoyer un message privé Réponse avec citation
Vieux 01/07/2009, 10h05   #4
Membre Expert
 
Avatar de aalex_38
 
Date d'inscription: septembre 2007
Messages: 1 455
Par défaut

Une solution pour maitriser ce que l'on fait est d'instancier :


Code :
Dim wb As Workbook
Dim F1 As Worksheet
 
Set wb = Workbooks.Open(Filename:=xfile)
Set F1 = wb.Worksheets.Add
With F1
    .Name = "LanouvelleFeuille"
End With
Finalement en reprenant ton code ça donne ceci :

Code :
Dim wb As Workbook
Dim F1 As Worksheet
Dim LstFich, xfile
 
Application.ScreenUpdating = False
'-------------------------------------'
'Ouverture des fichiers
'-------------------------------------'
LstFich = Application.GetOpenFilename("Fichiers Excel(*.xls),*.xls", , _
"Sélection des fichiers à convertir", , True) 'true pour une selection multiple
 
If Not IsArray(LstFich) Then Exit Sub
 
For Each xfile In LstFich
    
    Set wb = Workbooks.Open(Filename:=xfile)
    '-----------------------'
    ' Ajout d'une feuille
    '-----------------------'
    Set F1 = wb.Worksheets.Add
    With F1
     .Name = "LanouvelleFeuille"
    End With
    
    '-------------------------------------'
    ' Sauvegarde et fermeture du classeur
    '-------------------------------------'
    With wb
        .Save
        .Close
    End With
    
        
Next xfile
 
'-----------------------------------------------'
' Fermeture du classeur ou se trouve cette macro
'-----------------------------------------------'
ThisWorkbook.Close
 
Application.ScreenUpdating = True ' il parait que c pas ncr mais je le met tjrs
End Sub
__________________

Dernière modification par AlainTech ; 05/07/2009 à 07h42. Motif: Fusion de 2 messages
aalex_38 est déconnecté   Envoyer un message privé Réponse avec citation
Vieux 01/07/2009, 17h38   #5
Invité de passage
 
Date d'inscription: juin 2009
Localisation: France
Messages: 2
Par défaut

Merci c'est impécable !

Ca fonctionne à merveille

Merci pour les conseils et la solution !
Cedrick est déconnecté   Envoyer un message privé Réponse avec citation
Vieux 01/07/2009, 17h53   #6
Membre Expert
 
Avatar de aalex_38
 
Date d'inscription: septembre 2007
Messages: 1 455
Par défaut

Une dernière chose que j'ai oublié dans le code, liberer les objets.

Fin du code :

Code :
'-----------------------------------------------'
' On libère les objets
'-----------------------------------------------'
Set F1 = Nothing
Set wb = Nothing
'-----------------------------------------------'
' Fermeture du classeur ou se trouve cette macro
'-----------------------------------------------'
ThisWorkbook.Close
Citation:
Ca fonctionne à merveille
Je trouve aussi, le code est intéressant
__________________
aalex_38 est déconnecté   Envoyer un message privé Réponse avec citation
NEWS EXCELF.A.Q EXCELTUTORIELS EXCELSOURCES EXCELOUTILS EXCELLIVRES EXCELOFFICE 2010

Réponse Proposer ce sujet en actualité

Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel



Outils de la discussion

Règles de messages
Vous ne pouvez pas créer de nouvelles discussions
Vous ne pouvez pas envoyer des réponses
Vous ne pouvez pas envoyer des pièces jointes
Vous ne pouvez pas modifier vos messages

Les balises BB sont activées : oui
Les smileys sont activés : oui
La balise [IMG] est activée : oui
Le code HTML peut être employé : non
Trackbacks are non
Pingbacks are non
Refbacks are non



Fuseau horaire GMT +1. Il est actuellement 00h59.


Vos questions techniques : forum d'entraide Excel - Publiez vos articles, tutoriels et cours
et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones
Nous contacter - Hébergement - Participez - Copyright © 2000-2010 www.developpez.com - Legal informations.