Discussion :

[Passepartout007]

Bonjour,
J'ai un bloc note ou je centralise toutes les données et je les importes à l'aide de cette macro :

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
 
'****************************************
'Debut macro Import de la base de données
Sub import_bas()
Application.ScreenUpdating = False 'désactive l'actualisation de l'écran
Application.Calculation = xlCalculationManual 'désactive les calcule dans excel
  Nom_Dos = "\Base_txt\" 'le nom du dossier Nom_Dos prend comme valeur "\Base_txt\"
    rep_out = Suivi_FT.Path & Nom_Dos ' Rep_Out prend la valeur de l'emplacement du fichier excel + Nom_Dos
    fic_bd = "DataBase.txt" 'Le fichier base de données en txt prend le nom de "DataBase.txt"
    Workbooks.Add 'Créé un workbooks
    Set wrk = ActiveWorkbook 'on atribut un nom au workbook créé en lui mettant wrk comme nom
    Suivi_FT.Activate 'active le workbook ou se trouve la macro (le fichier avec le tableau
    Range("2:100000").ClearContents 'Supprime tout les lignes du tableau
    Close #1
    Open rep_out & fic_bd For Input As #1 'Ouvre le fichier text
 
    Do While Not EOF(1) 'tant que le fichier n'est pas entierement parcourus
        Line Input #1, texte_in 'la ligne du text deviens texte_in
 
        cpt = cpt + 1 'compteur pour géré le copier sur la bonne ligne
        wrk.Worksheets(1).Cells(cpt, 1).value = texte_in ' dans le worksheet wrk on copie la ligne qui se trouve dans text_in au numéro de ligne cpt dans la case A
 
    Loop 'revenir a do while
 Close #1 'ferme le fichier txt 1
 wrk.Activate 'met en worksheet activate wrk
 Nbval = Application.WorksheetFunction.CountA([A:A]) 'compte le nombre de ligne
    'de la case A1 à la derniere case ou il y a du texte on utilise la fonction de séparer le texte par rapport au mort et on copie les données dans une céllule chacune
 
    Range(Cells(1, 1), Cells(Nbval, 1)).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlTextQualifierNone, ConsecutiveDelimiter:=False, Other:=True, OtherChar:=";" ', FormatNumber:="@"
 
 
     nbc = Application.WorksheetFunction.CountA([1:1]) 'on compte le nombre de colonne
     wrk.Worksheets(1).Activate 'on active les worsheet créer
     Range(Cells(2, 1), Cells(Nbval, nbc)).Copy 'on copie le tableau
     Suivi_FT.Worksheets("Base de données").Activate 'on active notre excel base de donné ou se trouve le tableau principal
     Range("A2").PasteSpecial xlPasteValues 'on copie et on retournera la valeur des case
     Application.CutCopyMode = xlNone 'copie les données
     wrk.Close False 'ferme le worksheet temporaire
     Range(Cells(Nbval + 1, 1), Cells(Nbval + 10, 1)).EntireRow.Delete 'supprime les lignes en dessous de ce qu'on viens de copier
Call DonnéesText
Application.Calculation = xlCalculationAutomatic 'réactive le calcule automatique
Application.ScreenUpdating = True 'on réactive lacualisation de l'ecrans
 
 
End Sub 'fin de macro
'fin macro Import de la base de données
'****************************************

Mon probleme c'est que excel réagis mal au données par exemple :
j'ai des données de type 00200 en les copiant il me les transforme en 200.
J'ai donc essayer d'imposer un :

Code :

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

FormatNumber:="@"

au niveau de

Code :

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

1
2
 Range(Cells(1, 1), Cells(Nbval, 1)).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlTextQualifierNone, ConsecutiveDelimiter:=False, Other:=True, OtherChar:=";" ', FormatNumber:="@"

Mais cela ne fonctionne pas.
Avez vous une solution ?
Cordialement,
Passepartout007

[Patrice740]

Bonjour,

Pour ouvrir le fichier tu peux utiliser Workbooks.OpenText et définir un Array pour FieldInfo

[Menhir]

100% d'accord avec Patrice740.

Passepartout007, tu te compliques la vie en passant par un import séquentiel alors qu'il est bien plus simple de faire ça en une seule ligne de code.
Pour plus d'info, lire ça : https://docs.microsoft.com/fr-FR/off...books.opentext
Fais particulièrement attention en paramètre FieldInfo qui concerne très précisément ton problème.

Autre détail : un petit coup d'enregistreur automatique de macros en faisant bien attention aux commandes que tu effectues et tu auras 90% du code qui te tombera tout chaud dans le bec (j'ai bien dit 90% et pas 100%, à toi d'ajuster les 10% restant).

[Passepartout007]

bonjour,

Merci a vous pour vos conseil voici- le code n'hésité si je m'i prend mal mais pour moi cela fonctionne.

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
'Debut macro Import de la base de données
Sub import_bas()
Dim chemin As String
Application.ScreenUpdating = False 'désactive l'actualisation de l'écran
'If Application.Calculation <> xlCalculationManual Then Application.Calculation = xlCalculationManual 'désactive les calcule dans excel
  Nom_Dos = "\Base_txt\" 'le nom du dossier Nom_Dos prend comme valeur "\Base_txt\"
    rep_out = Suivi_FT.Path & Nom_Dos ' Rep_Out prend la valeur de l'emplacement du fichier excel + Nom_Dos
    fic_bd = "DataBase.txt" 'Le fichier base de données en txt prend le nom de "DataBase.txt"
    Suivi_FT.Sheets("Base de données").Range("2:100000").ClearContents 'Supprime tout les lignes du tableau
 
    'de la case A1 à la derniere case ou il y a du texte on utilise la fonction de séparer le texte par rapport au mort et on copie les données dans une céllule chacune
chemin = rep_out & fic_bd
 
'***********        *********            *********             **********
'*                  *       *            *       *             *        *
'******             *********            *********             **********
'*                  *       *            **                    *        *
'*                  *       *            *   *                 *        *
'*                  *       *            *       *             *        *
   Workbooks.OpenText Filename:=chemin, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
       2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 4), Array(10, 2), Array(11, 2), Array(12 _
        , 4), Array(13, 4), Array(14, 2), Array(15, 2), Array(16, 4), Array(17, 4), Array(18, 2), _
        Array(19, 2), Array(20, 4), Array(21, 4), Array(22, 2), Array(23, 2), Array(24, 4), Array(25, 4), _
        Array(26, 2), Array(27, 2), Array(28, 4), Array(29, 2), Array(30, 2), Array(31, 4), Array(32, 4)), _
        TrailingMinusNumbers:=True
 
 
     Nbval = Workbooks(fic_bd).Application.WorksheetFunction.CountA([A:A])
     nbc = Workbooks(fic_bd).Application.WorksheetFunction.CountA([1:1]) 'on compte le nombre de colonne
     Range(Cells(2, 1), Cells(Nbval, nbc)).Copy 'on copie le tableau
     Suivi_FT.Worksheets("Base de données").Activate 'on active notre excel base de donné ou se trouve le tableau principal
     Range("A2").PasteSpecial xlPasteValues 'on copie et on retournera la valeur des case
     Application.CutCopyMode = xlNone 'copie les données
     Workbooks(fic_bd).Close False 'ferme le worksheet temporaire
     Range(Cells(Nbval + 1, 1), Cells(Nbval + 10, 1)).EntireRow.Delete 'supprime les lignes en dessous de ce qu'on viens de copier
Call DonnéesText
Application.Calculation = xlCalculationAutomatic 'réactive le calcule automatique
Application.ScreenUpdating = True 'on réactive lacualisation de l'ecrans
 
 
End Sub 'fin de macro

cordialement,
Passepartout007