Excel / Visual Basic / Création et transfert d'informations Résolu/Fermé

Question

Bonjour tout le monde,
Avant tout quelques explications :

Je dois ouvrir un Excel qui a des données sous format CSV,
une fois ce fichier ouvert, je dois récupérer certaines données de ce fichier et remplir un deuxième fichier avec ces données(fichier sous format Excel compatibilité 97-2003).

Comme je ne m'y connais pas encore trop dans le Excel/Visual Basic, j'ai quelques questions à vous poser !

Bon déjà je sais comment générer un fichier Excel près rempli en Visual Basic, il y a quelques tutos pour ça, ce que j'aimerais savoir c'est comment faire pour choisir le fichier que l'on veux ouvrir (celui sous format CSV) et sélectionner les quelques informations utiles à retranscrire dans le fichier généré sous format Excel (compatibilité 97-2003).

Merci d'avance aux personnes qui répondront à ce post et n'hésitez pas à me demander plus de détails si besoin !

Ah oui, et aussi savoir s'il y a forcément besoin de passer par le visual Basic pour faire ce genre de manipulation ?

Merci !

f894009 · Answer

Bonjour,

'code a affecter a un bouton sur une feuille
Sub Choix_Fichier_CSV()
    Dim CheminFichier As Variant
    Const Fichier As String = "Fichier CSV (*.csv), *.csv"
    Const Ext As String = "csv"
    
    'Choisir le fichier source
    CheminFichier = Application.GetOpenFilename(Fichier)
    'test pas de fichier selectionne
    If Right(SCheminFichier, 3) <> Ext Then
        MsgBox "Vous n'avez pas choisi de fichier csv !! Bye ..."
        Exit Sub
    Else
        'importer le fichier choisi
        Import_Fichier_rapport (CheminFichier)
    End If
End Sub

'code modife en partant d'un import donnees externes avec l'enregistreur de macro
'vous deverez adapter cette ligne
'.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
'en fonction du nombre de colonnes du fichier csv. 
'Le mieux serait de faire avec l'enregistreur de macro l'import de votre fichier
Sub Import_Fichier_rapport(Fichier)
    'nom de feuille a adapter
    Worksheets("Data_TXT").Activate
    Worksheets("Data_TXT").Cells.ClearContents
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Fichier, Destination:=Range("$A$1"))
        '.CommandType = 0
        '.Name = "498 499 23°C yaw pitch"
        .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 = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Ensuite nous verrons pour la collecte des donnees

A+

f894009 · Answer

Re,

fichier excel xls et fichier csv pour demo, les cellules copiees sont dans les colonnes texte en rouge, adaptez a votre besoin

https://www.cjoint.com/c/EIEmm6dyrqf

f894009 · Answer

Re,

sub Traitement a remplacer. Je me repete, deux fois copie de colonne D normal ou pas et infos fixe J : 1,98001E+11-----> Z'etes sur

Sub Traitement()
    With Worksheets("feuil1")
        'raz cellules
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:P" & derlig).ClearContents
        'ecriture Infos automatiques
        derlig = Worksheets("Import_CSV").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Import_CSV").Range("A2:A" & derlig).Copy .Range("E2:E" & derlig)
        Worksheets("Import_CSV").Range("B2:B" & derlig).Copy .Range("H2:H" & derlig)
        Worksheets("Import_CSV").Range("C2:C" & derlig).Copy .Range("I2:I" & derlig)
        Worksheets("Import_CSV").Range("D2:D" & derlig).Copy .Range("L2:L" & derlig)
        Worksheets("Import_CSV").Range("D2:D" & derlig).Copy .Range("P2:P" & derlig)
        'ecriture Infos fixes
        'A:  R1W5R1W5
        .Range("A2:A" & derlig) = "R1W5R1W5"
        'B:  TV
        .Range("B2:B" & derlig) = "TV"
        'C:  R1W5R1W5
        .Range("C2:C" & derlig) = "R1W5R1W5"
        'D:  N
        .Range("D2:D" & derlig) = "N"
        'F:  UJF2015
        .Range("F2:F" & derlig) = "UJF2015"
        'G:  UJF2015
        .Range("G2:G" & derlig) = "UJF2015"
        'J : 1,98001E+11
        .Range("J2:J" & derlig) = "1,98001E+11"
        'K : 10101010101
        .Range("K2:K" & derlig) = "10101010101"
        'M:  FR
        .Range("M2:M" & derlig) = "FR"
        'N:  EUR
        .Range("N2:N" & derlig) = "EUR"
        'O:  structure UJF
        .Range("O2:O" & derlig) = "structure UJF"
    End With
End Sub

f894009 · Answer

Re, code modifie: Sub Traitement() With Worksheets("feuil1") 'raz cellules derlig = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:P" & derlig).ClearContents 'ecriture Infos automatiques derlig = Worksheets("Import_CSV").Range("A" & Rows.Count).End(xlUp).Row Worksheets("Import_CSV").Range("A2:A" & derlig).Copy .Range("E2:E" & derlig) Worksheets("Import_CSV").Range("B2:B" & derlig).Copy .Range("H2:H" & derlig) Worksheets("Import_CSV").Range("C2:C" & derlig).Copy .Range("I2:I" & derlig) Worksheets("Import_CSV").Range("D2:D" & derlig).Copy .Range("L2:L" & derlig) Worksheets("Import_CSV").Range("D2:D" & derlig).Copy .Range("P2:P" & derlig) Worksheets("Import_CSV").Range("F2:F" & derlig).Copy .Range("A2:A" & derlig) 'suppression lignes <> "create" For x = derlig To 2 Step -1 If .Range("A" & x) <> "create" Then .Rows(x).Delete End If Next x 'ecriture Infos fixes derlig = .Range("A" & Rows.Count).End(xlUp).Row 'A: R1W5R1W5 .Range("A2:A" & derlig) = "R1W5R1W5" 'B: TV .Range("B2:B" & derlig) = "TV" 'C: R1W5R1W5 .Range("C2:C" & derlig) = "R1W5R1W5" 'D: N .Range("D2:D" & derlig) = "N" 'F: UJF2015 .Range("F2:F" & derlig) = "UJF2015" 'G: UJF2015 .Range("G2:G" & derlig) = "UJF2015" 'J : 1,98001E+11 .Range("J2:J" & derlig) = "1,98001E+11" 'K : 10101010101 .Range("K2:K" & derlig) = "10101010101" 'M: FR .Range("M2:M" & derlig) = "FR" 'N: EUR .Range("N2:N" & derlig) = "EUR" 'O: structure UJF .Range("O2:O" & derlig) = "structure UJF" End With End Sub