programme écriture en boucle sur fichier excel [Résolu]

[varik]

Bonjour tout le monde et vous remercie d'avance pour l'attention que vous portez à ce post:

je voudrais faire tourner en boucle cet macro sur un répertoire contenant des sous répertoire afin de renommer ou écraser le contenu champs cellules ciblé avec de caractères.avant que j'oublie il y a beaucoup de fichier à corriger et cela peut dépasser les milles fichiers excel . j'aimerais aussi conserver leur format excel d'origine.

je pense que vous avez sais que je suis débutant en vb et que je fais tout pour en comprendre le plus possible .

j'ai choisi le mode ADO car les fichiers sont sur un lecteur du réseaux .

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub SetExternalDatas(DestFile As String, _
               DestFeuille As String, _
               DestCellAdr As String, _
               DataToWrite As Variant)
Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset
Dim RangeDest
'd'après Rob Bovey, mpep
 
 
  Set oConn = New ADODB.Connection
  oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & DestFile & ";" & _
           "Extended Properties=""Excel 8.0;HDR=No;"";"
 
 
  Set oCmd = New ADODB.Command
  oCmd.ActiveConnection = oConn
 
 
j'ai pas envie de me tromper dans cette partie du code ou je dois spécifier les cellules ciblés ainsi que les données à écrire donc si vous pouvez me renseignez  
 
  RangeDest = DestCellAdr & ":" & DestCellAdr
  oCmd.CommandText = "SELECT * from `" & DestFeuille & "$" & RangeDest & "`"
 
 
  Set oRS = New ADODB.Recordset
  oRS.Open oCmd, , adOpenKeyset, adLockOptimistic
 
 
  oRS(0).Value = DataToWrite
  oRS.Update
 
 
  oConn.Close
  Set oConn = Nothing
  Set oCmd = Nothing
  Set oRS = Nothing
 
End Sub

je reste à votre disposition pour tout renseignement et vous remercie d'avance de m'apporte vos idées ainsi que vos précieux conseils

[varik]

Bonjour
je reviens sur le forum car il y a des points que j'ai pas encore saisi :
je souhaite écrire ou plutôt modifier le contenu de deux cellules . je désire écrire du texte plus précisément sauf que le problème que j'ai c'est au niveau de la syntaxe car je sais pas comment indiquer à la fonction le contenu de chaque cellules ciblé .

je vous remercie d'avance et je tien à signaler que j'ai cherché sur le forum mais j'ai pas trouvé ce que je voulais exactement ; j'ai peut être mal cherché .

[jfontaine]

Bonjour,

Ci dessous une méthode

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim wrk As Workbook
 
'Ouvre le classeur à modifier
Set wrk = Application.Workbooks.Open("C:\Classeur_a_modifier.xls")
 
'modifie la cellule A1 de l'onglet Feuil1
wrk.Sheets("Feuil1").Range("A1").Value = "nouvelle valeur"
 
'Sauvegarde le classeur
wrk.Save
 
'Ferme le classeur et libère la variable wrk
wrk.Close
Set wrk = Nothing

[kiki29]

Salut, dans ce cas tu as du lire ceci http://silkyroad.developpez.com/VBA/ClasseursFermes/ ?

[varik]

Bonjour tout le monde.
J'arrive toujours pas à atteindre mon objectif qui est celui d'écrire avec une macro sur plusieurs fichiers Excel stockés dans différents dossiers mais ayant un seul dossier parent.

J'arrive pas à faire à établir la connexion.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
Sub PRINTER()
Dim Cn As ADODB.Connection
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook
 
MonRepertoire = "C:\..\.."
 
Set Cn = New ADODB.Connection
Set Fso = CreateObject("Scripting.FileSystemObject")
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & MonRepertoire & ";" & _
        "Extended Properties=""Excel 8.0;HDR=No;"";"
 
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    For Each f2 In f1.Files
        Set wb = Workbooks.Open(f2)
        ActiveSheet.Cells(11, 44).Value = "xxxxxxxxxxx"
        ActiveSheet.Cells(25, 39).Value = "xxxxxxxxxxx"
        wb.Close
     Next f2
Next f1
End Sub

merci à celui qui pourra me renseigner

coucou
j'essaie d'écrire sur plusieurs fichiers excel en boucle for each;le soucis est que mon programme ouvre réellement les fichiers .

est ce vous pouvez m'aidez svp pour finir mon petit programme tout en sachant que j'ai un besoin urgent.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook
 
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\..\"
 
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    For Each f2 In f1.Files
        Set wb = Workbooks.Open(f2)
        ActiveSheet.Cells(11, 44).Value = "bla bla bla"
        ActiveSheet.Cells(25, 39).Value = "bla bla bla"
        f2.Close
        wb.Close
     Next f2
Next f1
End Sub

je vous remercie de votre compréhension

[casefayere]

Bonjour,
2 fois la meme demande
même s'il il y a urgence, penses aux balises "code" =>"#"

cette ligne doit être à revoir :

Code :

Set wb = Workbooks.Open(f2)

enfin, je pense......

[varik]

merci de votre collaboration et je reviens à vous car j'ai besoin de votre aide encore une fois.
la fonction m'ouvre réellement le fichier excel au lieu d'écrire directement sans affichage.

autre précision: les fichier excel sont de 97-2003 et j'aimerais qu'il conserve leur format.

avant que j'oublie mes feuill1 ont des noms différent

merci d'avance

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Option Explicit
Sub PRINTER()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wrk As Workbook
 
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\Documents and Settings\FR22034\Bureau\RETEST"
 
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    For Each f2 In f1.Files
 
    Set wrk = Application.Workbooks.Open(f2)
 
'modifie la cellule A1 de l'onglet Feuil1
wrk.ActiveSheet.Cells(11, 44).Value = "xxxxxxxxx"
wrk.ActiveSheet.Cells(25, 39).Value = "xxxxxxxxx"
 
 
'Sauvegarde le classeur
wrk.Save
 
'Ferme le classeur et libère la variable wrk
wrk.Close
Set wrk = Nothing
     Next f2
Next f1
End Sub

[varik]

salut
je tiens tout d'abord à remercier tout les membres actifs ;

je dois modifier mon code actuel et faire en sorte de parcourir l’arborescence de mon répertoire sur trois niveaux car là mon programme s'arrête au niveau deux

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
  Dim Fso As Object, MonRepertoire As String
  Dim f1 As Object, f2 As Object, wb As Workbook
  Set Fso = CreateObject("Scripting.FileSystemObject")
  MonRepertoire = "C:\...\.."
  For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    For Each f2 In f1.Files
        Application.DisplayAlerts = False
          Set wb = Workbooks.Open(f2)
          ActiveSheet.Cells(11, 44).Value = "My bla bla"
          ActiveSheet.Cells(25, 39).Value = "My bla bla"
          wb.SaveAs Filename:=wb.Path & "\" & wb.Name
          Application.DisplayAlerts = True
         wb.Close False
    Next f2
  Next f1
End Sub

merci pour vos reflexion

[mercatog]

Regarde ici, tu auras un début de réponse
http://excel.developpez.com/faq/inde...riptingRuntime

[Edit]
Exemple

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub Traitement(ByVal Repertoire As String)
Dim Fso As Object, SourceFolder As Object, SubFolder As Object, FileItem As Object
Dim Wbk As Workbook
 
On Error GoTo Traitement_Error
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
 
For Each FileItem In SourceFolder.Files
    If InStr(FileItem.Name, ".xls") > 0 Then
        Set Wbk = Workbooks.Open(FileItem)
        With Wbk.Worksheets(1)
            .Cells(11, 44).Value = "My bla bla"
            .Cells(25, 39).Value = "My bla bla"
        End With
        Wbk.Close True
        Set Wbk = Nothing
    End If
Next FileItem
 
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
    Traitement SubFolder.Path
Next SubFolder
 
Traitement_Error:
Application.DisplayAlerts = True
Set SourceFolder = Nothing
Set Fso = Nothing
End Sub

A tester comme ceci

Code :

1
2
3
4
Sub Test()
 
Traitement "C:\Users\user\Desktop"
End Sub

[varik]

Merci beaucoup mercatog , que ce soit pour le lien que pour le code