Discussion :

[GWuigcos]

Bonjour à tous,

je me vois à nouveau contraint de soliciter votre aide.
J'ai une macro qui propose à l'utilisateur de choisir un fichier, fichier qui sera ensuite importé dans le fichier excel en cours.
Cela marche assez bien pour des classeurs en .xls mais lorsqu'il s'agit d'importer un classeur en .csv ça coince...

Voilà le code que j'ai pour l'instant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
fichier2 = Application.GetOpenFilename
If fichier2 = False Then Exit Sub
MsgBox "vous avez sélectionné le fichier " & fichier2
Application.ScreenUpdating = False
Set fbcalcul = Worksheets("TBR")
Set wbsource1 = Workbooks.Open(fichier2)
wbsource1.SaveAs Replace(wbsource1.FullName, ".csv", ".xlsx"), 50
fichier3 = Left(wbsource1.Name, Len(wbsource1.Name) - 5) & ".xlsx"
Set wbsource2 = Workbooks.Open(fichier3)
Set fimpor1 = wbsource2.Sheets(1)
fimpor1.Range("A2:P10000").Copy fbcalcul.Cells(fbcalcul.UsedRange.Rows.Count + 1, 1)
wbsource2.Close False

Quand je vais dans mon dossier, une version en .xls du classeur a bien été enregistrée mais la conversion n'est pas réalisée. En effet au lieu d'apparaître chacun dans une colonne, mes élements s'affichent comme ça :
61;32;32;0;0;0;0;0;0;0;0;01/02/2013;
dans la première colonne

Savez-vous d'où ça peut venir ?

[Invité]

Bonsoir,
A mon avis le PB vient de ce que les délimiteurs de champs sont inappropriés. Par défaut ce sont des tabulations.
Le code qui suit n'est là que pour te donner une piste de recherche.
Tout d'abord il faut utiliser [Importation des données] dans [Données externes]
Vois en ligne 20 le paramètre indispensable.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\Mes Documents\EXCEL\exemple.csv", Destination:=Range("A1"))
        .Name = "exemple"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True 'Cette ligne initialise les points virgules comme délimiteurs
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With

Cordialement.
Jean-Claude

[kiki29]

Salut, à toi de poursuivre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Sub SelectionFichier()
Dim Wkb As Workbook
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "Fichier"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        .ButtonName = "Sélection Fichier"
        .Show
        If .SelectedItems.Count > 0 Then
            Set Wkb = Application.Workbooks.Open(.SelectedItems(1), UpdateLinks:=xlUpdateLinksNever, _
                    ReadOnly:=True, Local:=True)
 
            ' etc ....
 
 
            Set Wkb = Nothing
        End If
    End With
End Sub

[bavmorda1]

ce sujet m'interesse ENORMEMENT !!!
j'en étais arrivé au meme résultat mais.... par ce qu'il y en a toujours un, je n'arrive pas à réinjecter le chemin récupéré dans la suite...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
42
43
44
45
46
47
48
49
Sub recup_extr()
 
'mise à vide de la feuille
 
Range("A2:AZ6500").Select
    Selection.ClearContents
 
 
' Récupère l'emplacement du fichier
On Error GoTo 1
Dim finput As FileDialog
Set finput = Application.FileDialog(msoFileDialogFilePicker)
finput.InitialFileName = ThisWorkbook.Path & "\"
finput.AllowMultiSelect = False
finput.Show
 
chemintemp = finput.SelectedItems(1)
1:
 
    With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;chemintemp", Destination:=Range("$A$2"))
 
' "TEXT;D:\NOMENCLATURE\extNomISO.txt", Destination:=Range("$A$2"))
        .Name = "extraction"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

je pense que c'est ça la merdouille mais comment je dois faire?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;chemintemp", Destination:=Range("$A$2"))

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;chemintemp", Destination:=Range("$A$2"))

[bavmorda1]

juste pour dire que j'ai résolu mon probleme comme ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"TEXT;" & chemintemp, Destination:=Range("$A$2"))