FORUM Tom's Hardware » Programmation » VB / VBA / VBS » Aide VBA svp macro qui enregistre un contenu
 

Aide VBA svp macro qui enregistre un contenu

Il y a 422 utilisateurs connus et inconnus. Pour voir la liste des connectés connus, cliquez ici
Ajouter une réponse



 Mot :   Pseudo :  
 
 Page :   1  2  3
Page Suivante 
Page Précédente 
Bas de page 
Auteur
 Sujet : Aide VBA svp macro qui enregistre un contenu
 
chamakh51
Plus d'informations
n°32064
13-06-2007 à 14:24:02

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

hoegarden3 1
Plus d'informations
n°32065
13-06-2007 à 14:42:02

lu j'ai peut etrte une solution pour toi :

Code :
  1. Option Explicit
  2.     Public dossier
  3.     Public Type BROWSEINFO
  4.         hOwner As Long
  5.         pidlRoot As Long
  6.         pszDisplayName As String
  7.         lpszTitle As String
  8.         ulFlags As Long
  9.         lpfn As Long
  10.         lParam As Long
  11.         iImage As Long
  12.     End Type
  13.     '32-bit API declarations
  14.     Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  15.     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  16.     Declare Function SHBrowseForFolder Lib "shell32.dll" _
  17.     Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  19. Function GetDirectory(Optional Msg) As String
  20.     Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
  21.     bInfo.pidlRoot = 0&
  22.     If IsMissing(Msg) Then
  23.         bInfo.lpszTitle = ""
  24.     Else
  25.         bInfo.lpszTitle = Msg
  26.     End If
  27.     bInfo.ulFlags = &H1
  28.     x = SHBrowseForFolder(bInfo)
  29.     path = Space$(512)
  30.     r = SHGetPathFromIDList(ByVal x, ByVal path)
  31.     If r Then
  32.         pos = InStr(path, Chr$(0))
  33.         GetDirectory = Left(path, pos - 1)
  34.     Else
  35.         GetDirectory = ""
  36.     End If
  37. End Function
  38. Sub File_Openen()
  39.     Dim fs, i, namefile, FileNumber, specfichier, nbfiles, r, Srep, folder, ct
  40.     dossier = GetDirectory("Choisit un dossier : " )
  41.     If dossier <> "" Then
  42.         Set fs = Application.FileSearch
  43.         With fs
  44.             .LookIn = dossier
  45.             .SearchSubFolders = True
  46.             .FileType = msoFileTypeAllFiles
  47.             If .Execute() > 0 Then
  48.                 nbfiles = .FoundFiles.Count
  49.                 MsgBox "Il y a " & nbfiles & " Fichiers."
  51. For i = 1 To nbfiles
  52.                         specfichier = .FoundFiles(i)
  53.   Range("A" & i) = specfichier
  54. Next i
  55. End If
  56. End With
  57. End If
  58. 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


Message édité par hoegarden3 1 le 13-06-2007 à 14:42:36

---------------

 
hoegarden3 1
Plus d'informations
n°32066
13-06-2007 à 14:46:27

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


---------------

 
chamakh51
Plus d'informations
n°32067
13-06-2007 à 14:51:10

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

hoegarden3 1
Plus d'informations
n°32070
13-06-2007 à 15:03:30

ah ok ben tu peux deja utiliser le debut puis changer le code entre la boucle for et tu y mets de style :

Code :
  1. Workbooks.Open Filename:=specfichier


se qui donne :

Code :
  1. Option Explicit
  2.     Public dossier
  3.     Public Type BROWSEINFO
  4.         hOwner As Long
  5.         pidlRoot As Long
  6.         pszDisplayName As String
  7.         lpszTitle As String
  8.         ulFlags As Long
  9.         lpfn As Long
  10.         lParam As Long
  11.         iImage As Long
  12.     End Type
  13.     '32-bit API declarations
  14.     Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  15.     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  16.     Declare Function SHBrowseForFolder Lib "shell32.dll" _
  17.     Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  19. Function GetDirectory(Optional Msg) As String
  20.     Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
  21.     bInfo.pidlRoot = 0&
  22.     If IsMissing(Msg) Then
  23.         bInfo.lpszTitle = ""
  24.     Else
  25.         bInfo.lpszTitle = Msg
  26.     End If
  27.     bInfo.ulFlags = &H1
  28.     x = SHBrowseForFolder(bInfo)
  29.     path = Space$(512)
  30.     r = SHGetPathFromIDList(ByVal x, ByVal path)
  31.     If r Then
  32.         pos = InStr(path, Chr$(0))
  33.         GetDirectory = Left(path, pos - 1)
  34.     Else
  35.         GetDirectory = ""
  36.     End If
  37. End Function
  38. Sub File_Openen()
  39.     Dim fs, i, namefile, FileNumber, specfichier, nbfiles, r, Srep, folder, ct
  40.     dossier = GetDirectory("Choisit un dossier : " )
  41.     If dossier <> "" Then
  42.         Set fs = Application.FileSearch
  43.         With fs
  44.             .LookIn = dossier
  45.             .SearchSubFolders = True
  46.             .FileType = msoFileTypeAllFiles
  47.             If .Execute() > 0 Then
  48.                 nbfiles = .FoundFiles.Count
  49.                 MsgBox "Il y a " & nbfiles & " Fichiers."
  51. For i = 1 To nbfiles
  52.                         specfichier = .FoundFiles(i)
  53.   Workbooks.Open Filename:=specfichier
  54. Next i
  55. End If
  56. End With
  57. End If
  58. End Sub


cela ouvre tout les fichiers


---------------

 
chamakh51
Plus d'informations
n°32072
13-06-2007 à 15:10:02

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 .

Freeman23
Plus d'informations
n°32076
13-06-2007 à 15:21:06

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.


---------------
S'il n'y a pas de solution c'est qu'il n'y pas de problème
hoegarden3 1
Plus d'informations
n°32081
13-06-2007 à 15:33:21

et lit l'aide :
http://www.presence-pc.com/forum/p [...] 1356-1.htm

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

sinon tu fait ce code si :

Code :
  1. Sub test()
  2. Dim i, nom, ct
  3. For i = 1 To 4
  4. nom = InputBox(ct, "Nom de la colonne" & i & ":", "nom" )
  5. If nom = "" Then
  6. Exit For
  7. Else
  8. Cells(1, i) = nom
  9. End If
  10. Next i
  11. end sub


et tu l'execute sur chaque fichier ouvert


---------------

 
chamakh51
Plus d'informations
n°32083
13-06-2007 à 15:35:31

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
Profil : Modérateur libre
Plus d'informations
n°32084
13-06-2007 à 15:35:47

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 :
  1. Sub ouvrir_fichiers()
  2.     Dim monfichier As String
  3.     monfichier = Dir("c:\test\*.*" )
  4.     Do While monfichier <> ""
  5.         Workbooks.Open monfichier
  7.         ...
  9.         monfichier = Dir()
  10.     Loop
  11. End Sub


Message édité par zeb le 13-06-2007 à 15:36:28

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
chamakh51
Plus d'informations
n°32092
13-06-2007 à 16:09:54

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 .

chamakh51
Plus d'informations
n°32097
13-06-2007 à 16:34:17

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 :
  1. ' Code Visual Basic anglais
  2. Sub ouvrir_fichiers()
  3. 'l'instruction ChDir permet de se positionner
  4. 'sur un répertoire précis
  5. ChDir "C:\Documents and Settings\.....\Bureau\test\originaux"
  6. monfichier = Dir("*.*" )
  7. While monfichier <> ""
  8. Workbooks.Open monfichier
  9. monfichier = Dir()
  10. Range("A1" ).Select
  11.     Selection.EntireRow.Insert
  12.     Windows.Item(1).ActivateNext
  13.     Range("A1:G1" ).Select
  14.     Selection.Copy
  15.    
  16.     Windows.Item(1).ActivateNext
  17.     ActiveSheet.Paste
  18.     Windows.Item(1).ActivateNext
  19.     Range("B2:G3" ).Select
  20.     Application.CutCopyMode = False
  21.     Selection.Copy
  22.     Windows.Item(1).ActivateNext
  23.     Range("B2" ).Select
  24.     ActiveSheet.Paste
  25.     Range("B2:G3" ).Select
  26.     Application.CutCopyMode = False
  27.     Application.CutCopyMode = False
  28.     Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
  29.         :=1, Trend:=False
  30.     ActiveWindow.SmallScroll Down:=-3
  31.     Selection.AutoFill Destination:=Range("B2:G83" ), Type:=xlFillDefault
  32.     Range("B2:G83" ).Select
  33. Wend
  35. 'enquete_satisfaction()_
  36. '
  38. '
  39. ' Touche de raccourci du clavier: Ctrl+p
  40. '
  41.     Range("A1" ).Select
  42.     Selection.EntireRow.Insert
  43.     Windows.Item(1).ActivateNext
  44.     Range("A1:G1" ).Select
  45.     Selection.Copy
  46.    
  47.     Windows.Item(1).ActivateNext
  48.     ActiveSheet.Paste
  49.     Windows.Item(1).ActivateNext
  50.     Range("B2:G3" ).Select
  51.     Application.CutCopyMode = False
  52.     Selection.Copy
  53.     Windows.Item(1).ActivateNext
  54.     Range("B2" ).Select
  55.     ActiveSheet.Paste
  56.     Range("B2:G3" ).Select
  57.     Application.CutCopyMode = False
  58.     Application.CutCopyMode = False
  59.     Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
  60.         :=1, Trend:=False
  61.     ActiveWindow.SmallScroll Down:=-3
  62.     Selection.AutoFill Destination:=Range("B2:G83" ), Type:=xlFillDefault
  63.     Range("B2:G83" ).Select
  64. End Sub


Message édité par chamakh51 le 13-06-2007 à 19:16:02
zeb
Profil : Modérateur libre
Plus d'informations
n°32100
13-06-2007 à 16:36:21

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


Message édité par zeb le 13-06-2007 à 16:37:13

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
zeb
Profil : Modérateur libre
Plus d'informations
n°32101
13-06-2007 à 16:40:43

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



---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
chamakh51
Plus d'informations
n°32103
13-06-2007 à 16:46:58

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
Profil : Modérateur libre
Plus d'informations
n°32106
13-06-2007 à 17:10:55

Mr Propre te propose :

Code :
  1. Sub ouvrir_modifier_et_fermer_fichiers()
  2.     Dim ClasseurDepart As Workbook
  3.     Dim ClasseurAModifier As Workbook
  4.    
  5.     Set ClasseurDepart = Workbooks("nom du classeur de départ" )
  6.    
  7.     monfichier = Dir("C:\Documents and Settings\.....\Bureau\test\originaux\*.*" )
  8.     Do While monfichier <> ""
  9.         Set ClasseurAModifier = Workbooks.Open(monfichier)
  10.        
  11.         ClasseurAModifier.Worksheets(1).Rows(1).Insert
  12.         ClasseurDepart.Worksheets(1).Range("A1:G1" ).Copy ClasseurAModifier.Worksheets(1).Range("A1:G1" )
  13.         ClasseurDepart.Worksheets(1).Range("B2:G3" ).Copy ClasseurAModifier.Worksheets(1).Range("B2:G3" )
  14.        
  15.         ClasseurAModifier.Worksheets(1).Range("B2:G3" ).DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  16.         ClasseurAModifier.Worksheets(1).Range("B2:G3" ).AutoFill Destination:=Range("B2:G83" ), Type:=xlFillDefault
  17.        
  18.         ClasseurAModifier.Save
  19.         ClasseurAModifier.Close
  20.                        
  21.         monfichier = Dir()
  22.     Loop
  23.     Set ClasseurAModifier = Nothing
  24.     Set ClasseurDepart = Nothing
  25. End Sub


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
chamakh51
Plus d'informations
n°32129
13-06-2007 à 19:12:52

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
Profil : Modérateur libre
Plus d'informations
n°32134
13-06-2007 à 21:10:26

Il faudrait que tu révises les mots suivants :

  • Fichier
  • Classeur
  • Feuille


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
chamakh51
Plus d'informations
n°32148
14-06-2007 à 09:07:06

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

zeb
Profil : Modérateur libre
Plus d'informations
n°32156
14-06-2007 à 09:47:46

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]


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
chamakh51