Sauvegarde de données

offf28

XLDnaute Nouveau
Bonjour,

Je suis actuellement en stage et on m'a demandé de réaliser plusieurs macro...Mais c'est tout nouveau pour moi!!!

Voici mon problème:
Je dois extraire des données de fichiers csv qui sont contenus dans différents dossiers (deux fichiers dans History et trois dans Historique). Pour l'instant j'essaye de les convertir en fichier xls (ce qui ne pose pas de souci!!)
Mais par contre, je dois pouvoir créer un bouton me permettant de changer le chemin d'accès des fichiers!!! Là ça ce complique.
Pour l'instant j'ai réaliser le bouton changer les données qui ouvrent la boîte de dialogue ouvrir:
Voici mon code:

Donnees_source1.Cells(2, 2).Clear
Donnees_source1.Cells(3, 2).Clear
Donnees_source1.Cells(4, 2).Clear
NameW = "Noise_Ulysse.xls" 'Défini le nom du fichier dans lequel on souhaite transférer les données

''''''''''''''''''''''%%%%%%%%%%%%%%%Ouverture de la boîte dialogue "Ouvrir"%%%%%%%%%%%%%%%%%

Set fs = CreateObject("Scripting.FileSystemObject") ' Définition du driver ici on a accèes au lecteur "C:", "D:" et "E:"
DataFileName = Application.GetOpenFilename("Data files (*.csv), *.csv") 'Permet d'ouvrir la boîte de dialogue "Ouvrir"
If DataFileName = False Then 'Gère le bouton annuler de la boîte de dialogue "Ouvrir"
Exit Sub
End If
fname = fs.GetParentFolderName(DataFileName) 'Associe à fname l'adresse du dossier du fichier sélectionné sous forme de chaîne
Set f = fs.GetFolder(fname) 'Associe f à l'adresse du dossier où se trouve le fichier sélectionné sous forme d'un dossier folder
Set fc = f.Files 'On associe les références de tous les fichiers dans le répertoire f
'Renvoie le chemin du dossier dans lequel est conservé le fichier sélectionné
newdir = Dir(fname & "\*", vbDirectory)
Donnees_source1.Cells(2, 2) = newdir
Donnees_source1.Cells(3, 2) = DataFileName
Donnees_source1.Cells(4, 2) = fc


Comme vous pouvez le voir j'ai essayé de transférer certaines données (chemins d'accès) nécessaire pour la conversion xls dans des cellules Excel.
Ensuite j'ai créé un autre bouton acquisition qui me permettra d'aller chercher les données dans les fichiers concernés directement sans chercher de nouveau les fichiers avec le code ci-dessous:

'''''''''''''''''''''%%%%%%%%%%%%%%Initialisation de données%%%%%%%%%%%%%%%%%%%%%%%%%%%

fnum = 0
ReDim LFiles(0, 0)
Set newdir = Donnees_source1.Cells(2, 2)
Set DataFileName = Donnees_source1.Cells(3, 2)
Set fc = Donnees_source1.Cells(4, 2)

'''''''''''''''''''''%%%%%%%%%%%%%%Traitement des données acquises%%%%%%%%%%%%%%%%%%%%%%%%%%%
'While (newdir <> "")
'Application.ScreenUpdating = False
If newdir = "." Or newdir = ".." Then ' Ces deux boucles If permettent de vérifier en bits que newdir est un dossier
newdir = Dir()
If newdir = "." Or newdir = ".." Then
newdir = Dir() 'Renvoie le fichier sélectionné lors de l'ouverture
End If
End If

'''''''''%%%%Conervsion du fichier csv en xls%%%%
outn = InStrRev(DataFileName, ".") 'Définit le nombre de caractère par rapport au ".", cela permettra de supprimer le ".csv"
outname = Mid(DataFileName, 1, outn - 1) + ".xls" 'Réécriture de du chemin du fichier avec conversion en xls

'''''''''%%%%Transfert des fichiers%%%%
For Each f1 In folder_fichiers
ReDim Preserve LFiles(0, fnum)
LFiles(0, fnum) = f1.Name ' On place chaque fichier dans une case du tableau LFiles
fnum = fnum + 1
Next
fnum = fnum - 1 'Le premier fichier est enregistré dans l'espace "0,0" de LFiles
For j = 0 To fnum
DataFileName = LFiles(0, j)
Donnees_source1.Range("A" & (j + 1)).Value = DataFileName
Workbooks.Open FileName:=DataFileName 'Ouvre les classeurs contenus dans le dossier en format xls
nameonly = ActiveWorkbook.Name

Workbooks(nameonly).Close savechanges:=False
Workbooks(NameW).Activate

Next

End Sub

Voilà ci quelqu'un pouvait m'aider car les données sont enregistrées dans les cellules sont inutilisables!!!:confused:

Merci d'avance:)
 

Discussions similaires

Statistiques des forums

Discussions
314 628
Messages
2 111 343
Membres
111 109
dernier inscrit
djameldel