for each dossier

Version imprimable

for each dossier

bjr, je cherche votre aides S.V.P.
j'ai developpé une macro dont le but est de " enregistrer sous":

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub enregistrer_sous()
Application.ScreenUpdating = False
Dim sh As Worksheet
If [P18] <> "" And [O18] <> "" Then
ActiveWorkbook.Save
Application.DisplayAlerts = False 'éviter de devoir confirmer manuellement la suppression de chaque feuille
For Each sh In ThisWorkbook.Sheets
    If sh.Name = "RECAP" Then sh.Delete
Next
Application.DisplayAlerts = True
    ChDir _
        "C:\PV"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\PV\" & [P18].Value & Right(Sheets("courbes GI").Range("o18").Value, 2) & Left(Sheets("courbes GI").Range("o18").Value, 4) _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End If
Application.ScreenUpdating = True
End Sub

ma question est la suivante:
sachant que le dossier "c:\PV" contient plusieurs sous-dossier .
comment je peux "enregistrer sous" dans un sous-dossier de "C:\PV" dont le nom est le contenu de la cellule [P18].
merci d'avance.

Salut

Utilise l'instruction MkDir pour créer un nouveau dossier puis tu peux enregistrer dedans. De plus tu dois utiliser un objet Range pour accéder à la valeur de la cellule. J'ai fait un petit exemple en utilisant l'objet ThisWorkbook... que tu peux adapter en utilisant ActiveWorkbook à la place.
Code:

1 2 3 4 5 6 7 Sub toto() Dim nomFichier As String, nomDossier As String nomFichier = Feuil1.Range("B2").Value nomDossier = Feuil1.Range("A2").Value MkDir "C:\PV\" & nomDossier ThisWorkbook.SaveAs "C:\PV\" & nomDossier & "\" & nomFichier & ".xls" End Sub
Je ne me suis pas trop cassé la tête avec le nom du fichier que j'ai placé une cellule à côté du nom du fichier. N'oublies pas de mettre un "\" entre le nom du dossier et le nom du fichier, sinon, ça ne marchera pas.

07/02/2011, 14h58
abouhossam
merci zazaraignée
le prob c'est que les dossiers sont déjà créés comme le suivant :
Code:

1 2 3 4 C:\PV ..................... le dossier père -PV A -PV B les sous-dossiers -PV C
ce que je veux c'est :

Code:

"enregistrer-sous" dans le sous-dossier où le nom est "PV" & [P18]

merci d'avance

Ha! Ouais! Je m'disais aussi...

Alors t'as regardé de ce côté
Code:

1 2 3 4 ActiveWorkbook.SaveAs Filename:= _ "C:\PV\" & [P18].Value & Right(Sheets("courbes GI").Range("o18").Value, 2) & Left(Sheets("courbes GI").Range("o18").Value, 4) _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False
il me semble que [P18].Value fait référence à une cellule.
T'as essayé avec Range("P18").Value & "\" pour voir si ça marche ?

pour faciliter le prob
est ce que vous pouvez me convertir la phrase suivante en VBA:

Code:

1
2
3
4
5
6
7
8
for each dossier in "c:\PV"
 if dossier.name=range("p18").value
 ouvrir le dossier
 ActiveWorkbook.SaveAs Filename:= "C:\PV\dossier\" & [P18].Value & Right(Sheets("courbes GI").Range("o18").Value, 2) & Left(Sheets("courbes GI").Range("o18").Value, 4) _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
 end if
next

merci bcp.

Code:

1
2
3
4
5
6
ActiveWorkbook.SaveAs Filename:= "C:\PV\dossier\" & _
 	Range("P18").Value & "\" _    ' <-- correction ici
 	Right(Sheets("courbes GI").Range("o18").Value, 2) & _
 	Left(Sheets("courbes GI").Range("o18").Value, 4) _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

07/02/2011, 17h58
abouhossam

merci zazaraignée
le code ne pose pas de prob si je veux enregistrer dans c:\PV
mais le prob est comment boucler sur les sous-dossier de c:\PV et enregistrer dans le dossier c:\PV\range("p18").value
MERCI.
07/02/2011, 21h32
zazaraignée

Ça m'a traversé l'esprit quand j'ai lu ton premier post et je ne sais pas pourquoi je n'en ai pas parlé finalement...

En utilisant le FileSystemObject tu devrais y arriver. Il faut d'abord ajouter une référence à ton projet, menu Option > Références, tu coches Microsoft Scripting Runtime.

Pour le reste il faudrait que je révise mes notes...

sinon, il me semble que l'instruction Dir donne des résultats intéressants.
07/02/2011, 21h37
Qwazerty

Salut

Ça aidera peut être Zaza a mettre de l'ordre dans ses notes :D
http://www.developpez.net/forums/d89...nu-repertoire/

++
Qwaz
07/02/2011, 22h21
zazaraignée

Citation:

Envoyé par Qwazerty

Salut

Ça aidera peut être Zaza a mettre de l'ordre dans ses notes :D
http://www.developpez.net/forums/d89...nu-repertoire/

++
Qwaz

:mouarf1:

Mes notes de cours sont dans des caisses...

merci à tous
une dernière question :
est ce que le code suivant est juste :

Code:

1
2
3
4
5
6
7
8
9
10
11
Dim oSubFolder As Scripting.Folder
For Each oSubFolder In "c:\PV"
if oSubFolder.name=Sheets("xxx").Range("p18").Value then
ChDir _
        "G:\PV\oSubFolder"
 ActiveWorkbook.SaveAs Filename:= _
        "G:\PV\oSubFolder" & Range("p18").Value & Left(Sheets("courbes GI").Range("o18").Value, 4) _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
end if
Next oSubFolder

merci à vous.

bjr à tous
j'ai bien developpé le code de cette façon mais il ne me donne rien

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
Sub enregistrer_sous(dossier As String)
Dim sh As Worksheet
Dim FSO As Object, SourceFolder As Object, subfolder As Object
dossier = "c:\PV"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(dossier)
Application.ScreenUpdating = False
If [P18] <> "" And [O18] <> "" Then
'souvegarder le classeur source
ActiveWorkbook.Save
Application.DisplayAlerts = False 'éviter de devoir confirmer manuellement la suppression de chaque feuille
For Each sh In ThisWorkbook.Sheets
    If sh.Name = "RECAP" Then sh.Delete
Next
Application.DisplayAlerts = True
For Each subfolder In SourceFolder.SubFolders
  If subfolder.Name = Sheets("courbes GI").Range("p18").Value Then
    ChDir _
        subfolder
    ActiveWorkbook.SaveAs Filename:= _
        subfolder & [P18].Value & Right(Sheets("courbes GI").Range("o18").Value, 2) & Left(Sheets("courbes GI").Range("o18").Value, 4) _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
  End If
Next subfolder
End If
Application.ScreenUpdating = True
End Sub

est ce que vous pouvez m'aider à résoudre ce problème
merci bcp.

08/02/2011, 13h41
zazaraignée

Il me semble que tu devrais plutôt manipuler des objets FileSystemObjects, Drives, Folders et Flies.

Si tu n'as pas accès à l'aide de cette bibliothèque, télécharge l'aide de VB6 (MSDN) ici pour avoir sous la main l'aide nécessaire.
08/02/2011, 15h18
abouhossam

merci zazaraignée
en attendant le télechargement du fichier est ce que tu peux me corrigé le code SVP.
MERCI.

Essaies ceci (si j'ai bien compris)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Dim NomFich As String, Doss As String, SousDoss As String
 
Application.ScreenUpdating = False
ThisWorkbook.Save
With Sheets("courbes GI")
   If .Range("P18").Value <> "" And .Range("O18").Value <> "" Then
      NomFich = Right(.Range("O18").Value, 2) & Left(.Range("O18").Value, 4)
      Doss = "C:\PV"
      SousDoss = .Range("P18").Value
      Application.DisplayAlerts = False         'éviter de devoir confirmer manuellement la suppression de chaque feuille
      On Error Resume Next
      Sheets("RECAP").Delete
      On Error GoTo 0
      If Dir(Doss & "\" & SousDoss, vbDirectory) = "" Then MkDir (Doss & "\" & SousDoss)
      ThisWorkbook.SaveAs Doss & "\" & SousDoss & "\" & NomFich & ".xls"
      Application.DisplayAlerts = True
   End If
End With

08/02/2011, 17h45
abouhossam

merci mercatog votre code ça marche
et merci à vous tous
une toute petite question : ou je peux trouver des cours de VBA concernant surtout les répertoires.
merci
08/02/2011, 17h51
mercatog

Si tu lisais bien les réponses qu'on te fournit, la première réponse de Zaza pouvait t'aider.