Choisir un dossier de destination lors de l'appel d'une macro qui créer des fichiers.

[Vich]

Bonjour à tous,

Encore une fois j'ai besoin de vous pour mon stage =).

Voilà le problème qui se pose :

Lorsque j'appel ma macro elle créer 54 nouveaux fichier Excel dans le répertoire ou se trouve le fichier Excel de base (celui qui est divisé en 54 partie). Mes consignes sont que la macro doit demander où sauvegarder les nouveaux fichiers.

Il faut donc une windows form avec un explorateur de fichier, et d'après ce que j'ai recherché, ce n'est pas si simple à mettre en oeuvre.

Voici la macro qui créer les fichiers :

Sub TriICD()
Dim MonDico As Object
Dim i As Integer, NbLg As Long, J As Long
Dim Chemin As String
Dim Tablo

  Application.ScreenUpdating = False
  Chemin = ThisWorkbook.Path & Application.PathSeparator
  With Sheets("ICD")
    If .FilterMode = True Then .ShowAllData
    .Range("AE1") = .Range("B1")                      ' Prépares l'entête de la zone critère
    NbLg = .Range("B" & Rows.Count).End(xlUp).Row
    Set MonDico = CreateObject("Scripting.dictionary")
    For J = 2 To NbLg
      MonDico(.Range("B" & J).Value) = ""
    Next J
    Tablo = MonDico.keys
    If Sheets.Count <> 3 Then
        Sheets.Add(after:=Sheets(1)).Name = "Feuil1"
        Sheets.Add(after:=Sheets(1)).Name = "Feuil2"
    End If
    For i = 0 To UBound(Tablo)
      .Range("AE2") = Tablo(i)
      .Range("A1:AB" & NbLg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=.Range("AE1:AE2"), copytorange:=Sheets("Feuil2").Range("A1:AB1")
      Sheets("Feuil2").DrawingObjects.Delete
      Sheets("Feuil2").Copy
      With ActiveWorkbook
        .Sheets(1).Name = Tablo(i)
            Call ExportationToron
        .SaveAs Chemin & Tablo(i) & ".xlsx"
        .Close
      End With
    Next i
    .Range("AE1:AE2").ClearContents
  End With
  Sheets("Feuil2").Cells.Clear
  MsgBox "Création des " & MonDico.Count & " fichiers terminée"
End Sub

Merci d'avance pour votre aide toujours aussi précieuse =).

 

[vgendron]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

Salut
ci dessous un bout de code d'une macro que j'avais développé pour des besoins pro
si ca peut t'aider

''''''''''''''''''''ouverture des fichiers source et destinataire des données'''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'demande le fichier de mesure à ouvrir et l'ouvre et sauvegarde le drive et le path du fichier
MsgBox "donnez le nom du fichier contenant les mesures"
MesureFileToOpen = Application.GetOpenFilename("Fichiers excel (*.xls), *.xls")
'If MesureFileToOpen <> False Then
'    MsgBox "Ouvrir " & MesureFileToOpen
'End If
Workbooks.Open MesureFileToOpen
FileNomMesures = ActiveWorkbook.Name

ActualDriveParDefaut = "E:\"
ActualPathParDefaut = Application.DefaultFilePath
'MsgBox "path par défaut est: " & ActualPathParDefaut

NewDriveParDefaut = "L:\"
NewPathParDefaut = ActiveWorkbook.Path
'MsgBox "nouveau Path est: " & NewPathParDefaut


'demande le fichier de températures à ouvrir et l'ouvre
MsgBox "donnez le nom du fichier contenant les températures"
TemperatureFileToOpen = Application.GetOpenFilename("Fichiers excel (*.xls), *.*")
'If TemperatureFileToOpen <> False Then
'    MsgBox "Ouvrir " & TemperatureFileToOpen
'End If
Workbooks.Open TemperatureFileToOpen
'MsgBox "nom du classeur actif = " & ActiveWorkbook.Name
FileNomTempératures = ActiveWorkbook.Name


'crée- un nouveau classeur dans lequel les mesures et températures sont regroupées: servira pour remplir le masque
Set NvClasseur = Workbooks.Add
Do
FileSaveName = Application.GetSaveAsFilename(, "Fichiers excel (*.xls),*.xls")

'If fileSaveName <> False Then
'    MsgBox "Enregistrer sous " & fileSaveName
'End If
Loop Until FileSaveName <> False
NvClasseur.SaveAs Filename:=FileSaveName
'MsgBox "nom du classeur actif = " & ActiveWorkbook.Name
FileNomRésultats = ActiveWorkbook.Name


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

[Vich]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

Merci pour cette réponse, c'est intéressant mais ça ne correspond pas avec ce que j'aimerais faire.

Etant donné que dans l'entreprise dans laquelle je fais mon stage a environ 20 lecteur réseaux et que les fichiers sont susceptibles d'être enregistrer dans n'importe lequel de ces lecteurs réseaux il faudrais pouvoir choisir le chemin comme lorsque l'ont fais "enregistrer sous".

J'avais pensé à une simple windows form avec une texte box où la personne pourrais copier/coller le chemin du dossier où il souhaite enregistrer les fichiers mais j'aimerais quand même mieux avoir un explorateur de fichier.

 

[vgendron]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

bah justement, ma macro utilise l'explorateur windows..,??
MesureFileToOpen = Application.GetOpenFilename("Fichiers excel (*.xls), *.xls")

 

[vgendron]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

le GetOpenFilename ouvre la boite de dialogue Windows explorateur pour ouvrir un fichier existant
le GetSaveAsFilename fait la meme chose , mais pour enregistrer un nouveau classeur

'crée un nouveau classeur
Set NvClasseur = Workbooks.Add
Do
    FileSaveName = Application.GetSaveAsFilename(, "Fichiers excel (*.xls),*.xls")

    'If fileSaveName <> False Then
    '    MsgBox "Enregistrer sous " & fileSaveName
    'End If
Loop Until FileSaveName <> False
NvClasseur.SaveAs Filename:=FileSaveName
'MsgBox "nom du classeur actif = " & ActiveWorkbook.Name
FileNomRésultats = ActiveWorkbook.Name

 

[Vich]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

Merci Vgendron j'avais pas fais le rapprochement, je te tiens au courant lundi car je dois partir l'usine ferme à 16h ^^.

Merci encore,

Cdlt, Vich.

 

[Vich]

Re : Choisir un dossier de destination lors de l'appel d'une macro qui créer des fich

Bon bah, ça marche très bien merci pour ton aide.

Résolut.