Boite de dialogue pour choix de fichier cvs a importer

Le
Wheelo
Bonjour,

J'utilise la macro ci-dessous pour importer un fichier cvs; elle marche tres
bien mais j'ai besoin de pouvoir
choisir le fichier a importer sachant que j'ai une trame qui reprend et
presente les données de maniere differente
et que j'aurai un nouveau cvs a importer chaque semaine.

Bon etant donné que j'y connai pas grand chose a la programmation en vba je
suis passé par l'enregistreur
et donc il me cree une connection avec le fichier dont je n'ai absolument
pas besoin c'est pourquoi
j'importe les données en feuille 3 je les copie en feuille 2 et je supprime
les données sur feuille 3 pour couper le connection
je pense qu'il y a une maniere de passer au travers de tout ca avec un code
plus leger.

Sub Macro1()
'
' Macro1 Macro
'

'
Sheets("Sheet3").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:Documents and SettingsStandardMes documentsExportp.txt",
_
Destination:=Range("$A$1"))
.Name = "Exportp"
.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 = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:úlse
End With
Range("A1:N251").Select
Range("N251").Activate
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Sheets("Sheet3").Select
Application.CutCopyMode = False
Selection.QueryTable.Delete
Selection.ClearContents
Range("A1").Select
Sheets("Sheet2").Select
Range("A1").Select
Sheets("Sheet1").Select
Range("A1").Select
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
francois.forcet
Le #5286561
On 29 jan, 14:18, "Wheelo"
Bonjour,

J'utilise la macro ci-dessous pour importer un fichier cvs; elle marche tr es
bien mais j'ai besoin de pouvoir
choisir le fichier a importer sachant que j'ai une trame qui reprend et
presente les données de maniere differente
et que j'aurai un nouveau cvs a importer chaque semaine.

Bon etant donné que j'y connai pas grand chose a la programmation en vba je
suis passé par l'enregistreur
 et donc il me cree une connection avec le fichier dont je n'ai absolume nt
pas besoin c'est pourquoi
j'importe les données en feuille 3 je les copie en feuille 2 et je suppr ime
les données sur feuille 3 pour couper le connection
je pense qu'il y a une maniere de passer au travers de tout ca avec un cod e
plus leger.

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Sheet3").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:Documents and SettingsStandardMes documentsExp ortp.txt",
_
        Destination:=Range("$A$1"))
        .Name = "Exportp"
        .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 = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:úlse
    End With
    Range("A1:N251").Select
    Range("N251").Activate
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone ,
SkipBlanks _
        :úlse, Transpose:úlse
    Sheets("Sheet3").Select
    Application.CutCopyMode = False
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
    Sheets("Sheet2").Select
    Range("A1").Select
    Sheets("Sheet1").Select
    Range("A1").Select
End Sub


Salut à toi

Pour ouvrir un fichier text je n'utilise pas la fonction QueryTables
mais plutôt cette procédure :

ChDrive ("C")
ChDir ("C:Chemin")
Workbooks.OpenText Filename:=Application.GetOpenFilename("Fichier
(*.txt),"), Origin:=xlMSDOS _
, StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:úlse,
Comma:úlse _
, Space:úlse, Other:úlse, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True

L'instruction :

Application.GetOpenFilename("Fichier (*.txt),")

me permet d'utiliser une boîte de dialogue pour aller sélectionner le
fichier à ouvrir

les lignes :

ChDrive ("C")
ChDir ("C:Chemin")

Prépositionne la boîte de dialogue sur une partie du chemin

Le reste du code étant les paramètres à appliquer pour une ouverture
correcte que l'on peux obtenir par l'enregistreur de macro en fonction
du fichier à ouvrir

En mode enregistrement il suffit d'aller chercher le fichier par :

Fichier/ouvrir

sélectionner le fichier

Puis d'utiliser correctement l'assistant d'importation de text

Arréter l'enregistrement et récupérer le code

Celà devrait te convenir

Dis moi !!!!

Wheelo
Le #5286031
Bien comme ca ca marche je pensais qu'on pouvai le faire en direct
mais ca fonctionne de cette maniere il me fait juste une erreur si j'annule
l'ouverture du fichier mais ce n'est pas tres grave

Tu peux trés bien recopier du nouveau classeur les données >vers le
classeur de ton choix avec ces lignes >supplémentaires :
'Recopie des données
Cells.Copy Workbooks("Classeur de destination").Sheets("Onglet de
destination").Range("A1")
'Fermeture du nouveau classeur
ActiveWorkbook.Close SaveChanges:úlse

Cela Devrait te convenir

Dis moi !!!


francois.forcet
Le #5285881
On 30 jan, 11:43, "Wheelo"
Bien comme ca ca marche je pensais qu'on pouvai le faire en direct
mais ca fonctionne de cette maniere il me fait juste une erreur si j'annul e
l'ouverture du fichier mais ce n'est pas tres grave



Tu peux trés bien recopier du nouveau classeur les données >vers le
classeur de ton choix avec ces lignes >supplémentaires :
'Recopie des données
Cells.Copy Workbooks("Classeur de destination").Sheets("Onglet de
destination").Range("A1")
'Fermeture du nouveau classeur
ActiveWorkbook.Close SaveChanges:úlse

Cela Devrait te convenir

Dis moi !!!- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


Heureux que celà te convienne

Pour éviter l'erreur quand tu annules tu peux mettre en tout début de
code :

On Error Goto Fin

et en fin de code avant le End Sub :

Fin :
Exit Sub

Celà devrait résoudre cette petite imperfection

Dis moi !!!!


Wheelo
Le #5285591
Tip top par contre y a un truc qui manque encore
J'ai pas eu mon café !!

ps: ok c'est nul

Merci du temps consacré :)
Publicité
Poster une réponse
Anonyme