Aide VBA svp macro qui enregistre un contenu

  • Auteur de la discussion chamakh51
  • Date de début
C

chamakh51

Habitué
Bonjour

Je voudrais de l'aide pour faire une macro sur excel, celle-ci doit me mettre dans un tableau en memoire la liste des fichiers excel contenu dans un dossier.

merci de m'aider
 
hoegarden31

hoegarden31

Expert
lu j'ai peut etrte une solution pour toi :
Code: 
Option Explicit
    Public dossier
    Public Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    '32-bit API declarations
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(Msg) Then
        bInfo.lpszTitle = ""
    Else
        bInfo.lpszTitle = Msg
    End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub File_Openen()
    Dim fs, i, namefile, FileNumber, specfichier, nbfiles, r, Srep, folder, ct
    dossier = GetDirectory("Choisit un dossier : ")
    If dossier <> "" Then
        Set fs = Application.FileSearch
        With fs
            .LookIn = dossier
            .SearchSubFolders = True
            .FileType = msoFileTypeAllFiles
            If .Execute() > 0 Then
                nbfiles = .FoundFiles.Count
                MsgBox "Il y a " & nbfiles & " Fichiers."

 For i = 1 To nbfiles
                        specfichier = .FoundFiles(i)
  Range("A" & i) = specfichier
Next i
End If
End With
End If
End Sub
Ce programme te permet de selectionner un dossier puis il t'informe du nombre de fichiers contenu dans ce dossier puis il met les nom des fichier dans un tableau j'espere que c sa que tu cherche
 
hoegarden31

hoegarden31

Expert
par contre il va te mettre tout les fichier qui se trouvent dans le dossier donc pas que les fichier excel dsl je cherche un solution pour c probleme
 
C

chamakh51

Habitué
Non en fait je voudrais qu'il me liste le contenu du dossier, garder en memoire les noms de fichiers puis pouvoir les ouvrir 1 par 1 pour ajouter une ligne d'en-tete sur la 1ere ligne
 
hoegarden31

hoegarden31

Expert
ah ok ben tu peux deja utiliser le debut puis changer le code entre la boucle for et tu y mets de style :
Code: 
Workbooks.Open Filename:=specfichier
se qui donne :
Code: 
Option Explicit
    Public dossier
    Public Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    '32-bit API declarations
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(Msg) Then
        bInfo.lpszTitle = ""
    Else
        bInfo.lpszTitle = Msg
    End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub File_Openen()
    Dim fs, i, namefile, FileNumber, specfichier, nbfiles, r, Srep, folder, ct
    dossier = GetDirectory("Choisit un dossier : " )
    If dossier <> "" Then
        Set fs = Application.FileSearch
        With fs
            .LookIn = dossier
            .SearchSubFolders = True
            .FileType = msoFileTypeAllFiles
            If .Execute() > 0 Then
                nbfiles = .FoundFiles.Count
                MsgBox "Il y a " & nbfiles & " Fichiers."

For i = 1 To nbfiles
                        specfichier = .FoundFiles(i)
  Workbooks.Open Filename:=specfichier
Next i
End If
End With
End If
End Sub
cela ouvre tout les fichiers
 
C

chamakh51

Habitué
Non c'est bon j'ai reussi à ouvrir tout les fichiers d'un dossier


' Code Visual Basic anglais
Sub ouvrir_fichiers()
'l'instruction ChDir permet de se positionner
'sur un répertoire précis
ChDir "c:\test\"
monfichier = Dir("*.*")
While monfichier <> ""
Workbooks.Open monfichier
monfichier = Dir()
Wend
End Sub


Mais maintenant comment faire pour ajouter en haut de chaque fichiers sur la 1ere ligne une en-tete avec 5 noms de colonnes .
 
F

Freeman23

Expert
Fais le avec l'enregistreur de macro une fois, puis nettoie le code et fais en sorte que ca utilise le classeur que tu ouvres.
 
hoegarden31

hoegarden31

Expert
et lit l'aide :
Vous devez être connecté pour voir les liens.


sinon il y en a qui vont pas etre content :D

sinon tu fait ce code si :
[cpp]
Sub test()
Dim i, nom, ct
For i = 1 To 4
nom = InputBox(ct, "Nom de la colonne" & i & ":", "nom")
If nom = "" Then
Exit For
Else
Cells(1, i) = nom
End If
Next i
end sub
[/cpp]
et tu l'execute sur chaque fichier ouvert
 
C

chamakh51

Habitué
en fait j'ouvre plusieurs classeurs, le nombre de classeurs dans ce dossier varie, et je voudrais pour chaque qui entrent lancer la macro et que la 1ere ligne d'en-tete s'ajoute pour tout les classeurs une fois qu'ils sont ouvert.
 
zeb

zeb

Modérateur
Dixit moderator: chamakh51, fais comme les autres, présente ton code correctement. (Lire les règles, Merci).

Ce code ne date pas d'hier, la vache ! Des While/Wend :ouch:
Evite la fonction ChDir. Mets plutôt le chemin dans la fonction Dir.
En plus tu as oublié de déclarer la variable monfichier
Comme ça:
Code: 
Sub ouvrir_fichiers()
	Dim monfichier As String
	monfichier = Dir("c:\test\*.*" )
	Do While monfichier <> ""
		Workbooks.Open monfichier
		
		...
		
		monfichier = Dir()
	Loop
End Sub
 
C

chamakh51

Habitué
zeb mon code fonctionne pour ouvrir tout mes classeurs excel mais maintenant je voudrais pouvoir ajouter une ligne d'en tete en haut de chaque classeur qui s'ouvre!
En fait je reçois un classeur avec la colonne A pleine de code je veux une macro qui m'insere une ligne d'en-tete avec les propriétés suivantes ("no" en colonne A , "no_etud" en colonne B, "nom" en colonne 3, "prenom" en colonne 4) sur la 1ere ligne .
 
C

chamakh51

Habitué
Est-ce que quelqu'un peut m'adapter mon code pour que à chaque fois qu'un de mes fichiers s'ouvrent il y ajoute la ligne d'en-tete.

J'ai du mal avec les boucles.

Code: 
' Code Visual Basic anglais
Sub ouvrir_fichiers()
'l'instruction ChDir permet de se positionner
'sur un répertoire précis
ChDir "C:\Documents and Settings\.....\Bureau\test\originaux"
monfichier = Dir("*.*")
While monfichier <> ""
Workbooks.Open monfichier
monfichier = Dir()
Range("A1").Select
    Selection.EntireRow.Insert
    Windows.Item(1).ActivateNext
    Range("A1:G1").Select
    Selection.Copy
    
    Windows.Item(1).ActivateNext
    ActiveSheet.Paste
    Windows.Item(1).ActivateNext
    Range("B2:G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows.Item(1).ActivateNext
    Range("B2").Select
    ActiveSheet.Paste
    Range("B2:G3").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
        :=1, Trend:=False
    ActiveWindow.SmallScroll Down:=-3
    Selection.AutoFill Destination:=Range("B2:G83"), Type:=xlFillDefault
    Range("B2:G83").Select
Wend

'enquete_satisfaction()_
'

'
' Touche de raccourci du clavier: Ctrl+p
'
    Range("A1").Select
    Selection.EntireRow.Insert
    Windows.Item(1).ActivateNext
    Range("A1:G1").Select
    Selection.Copy
    
    Windows.Item(1).ActivateNext
    ActiveSheet.Paste
    Windows.Item(1).ActivateNext
    Range("B2:G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows.Item(1).ActivateNext
    Range("B2").Select
    ActiveSheet.Paste
    Range("B2:G3").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
        :=1, Trend:=False
    ActiveWindow.SmallScroll Down:=-3
    Selection.AutoFill Destination:=Range("B2:G83"), Type:=xlFillDefault
    Range("B2:G83").Select
End Sub
 
zeb

zeb

Modérateur
Dixit moderator: Edite ton message et écrit [/code] à la fin :o
EDIT: Je l'ai fait moi-même. :sarcastic:
 
zeb

zeb

Modérateur
Donc à la lecture de ton code, je m'aperçois qu'on peut te faire des commentaires, tu n'en a rien à battre.

Et bien en voilà encore deux :
■ Vire-moi tous les Select/Selection/ActiveMachin de ce code.
■ Au lieu de faire Copy / Paste / CutCopyMode = False, utilise simplement Copy Destination

 
C

chamakh51

Habitué
Ce n'est pas que je m'en bas mais je vien de commencer depuis 3-4 jours et j'essai de pas tro manipuler tant que celà fonctionne lol
Je vais essayer avec tes remarques et voir ce que celà donne
 
zeb

zeb

Modérateur
Mr Propre te propose :
Code: 
Sub ouvrir_modifier_et_fermer_fichiers()
    Dim ClasseurDepart As Workbook
    Dim ClasseurAModifier As Workbook
    
    Set ClasseurDepart = Workbooks("nom du classeur de départ")
    
    monfichier = Dir("C:\Documents and Settings\.....\Bureau\test\originaux\*.*")
    Do While monfichier <> ""
        Set ClasseurAModifier = Workbooks.Open(monfichier)
        
        ClasseurAModifier.Worksheets(1).Rows(1).Insert
        ClasseurDepart.Worksheets(1).Range("A1:G1").Copy ClasseurAModifier.Worksheets(1).Range("A1:G1")
        ClasseurDepart.Worksheets(1).Range("B2:G3").Copy ClasseurAModifier.Worksheets(1).Range("B2:G3")
        
        ClasseurAModifier.Worksheets(1).Range("B2:G3").DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
        ClasseurAModifier.Worksheets(1).Range("B2:G3").AutoFill Destination:=Range("B2:G83"), Type:=xlFillDefault
        
        ClasseurAModifier.Save
        ClasseurAModifier.Close
                        
        monfichier = Dir()
    Loop
    Set ClasseurAModifier = Nothing
    Set ClasseurDepart = Nothing
End Sub
 
C

chamakh51

Habitué
Que veux-tu dire par "nom du classeur de départ" ?
J'ai une feuille excel où j'ai mon en-tete et je voudrais que celle-ci se fasse sur tout les fichiers qui sont dans le dossier "originaux" .
 
zeb

zeb

Modérateur
Il faudrait que tu révises les mots suivants :
■ Fichier
■ Classeur
■ Feuille
 
C

chamakh51

Habitué
fichier = le fichier excel ?
Classeur = toutes les feuilles d'un fichier excel ?
Feuille = 1 page d'un fichier excel ?

 
zeb

zeb

Modérateur
Classeur = Fichiers Excel ;)

Le "nom du classeur de départ" = le nom du classeur qui contient la "feuille excel où j'ai mon en-tete" [:spamafote]
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 852
Membres
1 586 373
Dernier membre
https://forum.tomshardwar
Partager cette page
Haut