Répertoire courant macro VBA et Save as

**parmi** · 17/08/2013, 16h56

Peut-être pourrais-tu essayer d'ouvrir tes fichiers de cette manière.
Je pense, mais pas certain, que ça pourrait régler ton problème de ponctuation.

Fais un test pour voir en modifiant le code selon tes besoins.
Pour le DataObject, il faut une référence à MS Forms 2.0 Object Library

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
   Dim strTemp As String, Chemin As String, Fichier As String
    Dim MyDataObject As DataObject
 
    Chemin = ThisWorkbook.Path
 
    Open Chemin & "\" & Fichier For Binary As #1
        strTemp = Space$(LOF(1)) 'lecture du fichier d'un coup
        Get #1, , strTemp
 
        Set MyDataObject = New DataObject
        MyDataObject.SetText strTemp  'détermine le texte à mettre
        MyDataObject.PutInClipboard     'dans le presse-papier
        Range("A1").PasteSpecial
    Close #1
 
    MyDataObject.Clear
    Set MyDataObject = Nothing

**clementmarcotte** · 17/08/2013, 17h41

Bonjour,

Un individu de ma connaissance s'est toujours méfié de la compétence d'Excel quand il s'agit d'écrire des fichiers texte. Il se souvenait des vieilles méthodes de QuickBASIC pour écrire des fichiers textes et il a pondu différentes macros qui donnent des versions différentes de fichiers textes. Il a mis des commentaires dans chaque macro. Il suggère de toutes les essayer et de comparer les résultats finaux entre elles.

**mattchoco** · 17/08/2013, 17h47

@parmi : c'est une approche complétement différente, je vais essayer de ce pas

@clement : l'ouverture de ton lien m'a fait peur... j'ai fuis..

merci à vous deux en tout cas, j'ai essayer un milliard de combines et à chaque fois le même soucis apparait. il semble difficile de manier du csv à partir d'un xls;.

**AlainTech** · 17/08/2013, 18h18

Si tes fichiers CSV ne contiennent pas de données identifiables ou sensibles, peux-tu en mettre un exemple sur le forum?

A voir déjà l'exemple que tu donnes, on est face à un "pseudo" csv car il semble qu'il y ait plusieurs valeurs dans une "cellule".

Number Used Result Types;3;; 

Number Values;2029;2029;2029 
Freq ;Value ; Value ; Value 
100000;0 002948;0 002948;0 2948.000 
104882 8125;0 002468;0 002468;0 2468.000 
109765 625;0 001729;0 001729;0 1729.000

Si on regarde la dernière ligne, nous avons, avant le premier point-virgule, 2 valeurs. Et ainsi de suite pour les points-virgules suivants.
Excel ne pourra jamais interpréter ces groupes comme des nombres.

A moins que ce que tu nous montres soit le résultat après conversion.

**mattchoco** · 17/08/2013, 18h20

j'attendais qu'on me le demande, je me suis copieusement fait remonter les bretelles la dernière fois pour avoir "tout" mis dans le premier post..

je finis de potasser la soluc de parmi et je fais ça.

@parmi : en reprenant ton code et en bidouillant méchamment j'arrive à un résultat

, MAIS , si je relance la macro une deuxième fois un 12.345 devient un 12345.. ce qui est légèrement inquiétant..

le dernier code est celui ci :

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
Sub Bouton12_Cliquer()
 
 
   Dim strTemp As String, Chemin As String, Fichier As String
    Dim MyDataObject As DataObject
 
    Chemin = ThisWorkbook.Path
 
    Open Chemin & "\" & "bubu.csv" For Binary As #1
        strTemp = Space$(LOF(1)) 'lecture du fichier d'un coup
        Get #1, , strTemp
 
        Set MyDataObject = New DataObject
        MyDataObject.SetText strTemp  'détermine le texte à mettre
        MyDataObject.PutInClipboard     'dans le presse-papier
        Range("A1").PasteSpecial
    Close #1
 
    MyDataObject.Clear
    Set MyDataObject = Nothing
 
 
          Range("A1:A3000").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
 
 
    Range("A1:D3000").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 
 
 
End Sub

**Marc-L** · 17/08/2013, 18h25

Le lien de Clément est effectivement à l'ancienne, on peut faire plus court avec la fonction Join par exemple …

Qui plus est je n'ai jamais eu de souci avec les .csv, suffit de respecter le fonctionnement d'Excel,
notamment avec l'argument Local … Par exemple pour la France le séparateur est le point-virgule.

Mais souvent des .csv n'en sont pas, tout dépend du créateur du fichier !
Dans ce cas, mieux vaut intervenir directement à la lecture du fichier dans passer par une feuille intermédiaire.

J'interviens quant tenants et aboutissants sont clairs, ce qui n'est pas le cas dans ce sujet …

**mattchoco** · 17/08/2013, 18h32

Envoyé par Marc-L

Le lien de Clément est effectivement à l'ancienne, on peut faire plus court avec la fonction Join par exemple …

Qui plus est je n'ai jamais eu de souci avec les .csv, suffit de respecter le fonctionnement d'Excel,
notamment avec l'argument Local … Par exemple pour la France le séparateur est le point-virgule.

Mais souvent des .csv n'en sont pas, tout dépend du créateur du fichier !
Dans ce cas, mieux vaut intervenir directement à la lecture du fichier dans passer par une feuille intermédiaire.

J'interviens quant tenants et aboutissants sont clairs, ce qui n'est pas le cas dans ce sujet …

pourquoi tu interviens quand même alors?

c'est un peu fort quand même, tout le monde vois bien que j'y pige quedal au VBA. à quoi ça sert de dire qu'il faut respecter le fonctionnement d'excel, tu vois bien que je ne le connais pas.

à choisir, n'interviens pas ça sera encore mieux. il y a déjà des bonnes âmes qui s'occupe de moi. merci

**AlainTech** · 17/08/2013, 18h36

Envoyé par mattchoco

je me suis copieusement fait remonter les bretelles la dernière fois pour avoir "tout" mis dans le premier post..

Ceux qui sont censés se faire "remonter les bretelles", sont ceux qui nous jettent un fichier sans donner de code et en nous disant, en d'autres mots, débrouillez-vous pour trouver mon problème.

**mattchoco** · 17/08/2013, 18h38

bon l'import semble etre résolu, reste un petit détail :

dans le code de base, les données sont collés dans l'onglet courant:

Code :

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

1
2
3
4
5
6
7
8
9
Open Chemin & "\" & "bubu.csv" For Binary As #1
        strTemp = Space$(LOF(1)) 'lecture du fichier d'un coup
        Get #1, , strTemp
 
        Set MyDataObject = New DataObject
        MyDataObject.SetText strTemp  'détermine le texte à mettre
        MyDataObject.PutInClipboard     'dans le presse-papier
        Range("e10").PasteSpecial
    Close #1

que dois-je rajouter pour coller les données dans l'onglet que je veux ( différent de l'onglet courant)

Envoyé par AlainTech

Ceux qui sont censés se faire "remonter les bretelles", sont ceux qui nous jettent un fichier sans donner de code et en nous disant, en d'autres mots, débrouillez-vous pour trouver mon problème.

ça je le conçoit tout à fais. non j'avais fait un topic complet , mais on m'a répondu de ne mettre mes fichiers qu'en dernière limite pour pas encombrer..

le contraire me semblait logique pourtant.

**parmi** · 17/08/2013, 18h42

Ajoute le nom de l'onglet devant Range("E10")

Code :

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

Sheets("NomDeFeuille").Range("e10").PasteSpecial

et éventuellement le nom du classeur (?)

Code :

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

ThisWorkbook.Sheets("NomDeFeuille").Range("e10").PasteSpecial

**mattchoco** · 17/08/2013, 18h53

je travaille dans le meme classeur une fois que les données sont importées.

pour l'import c'est ok, ça marche.

par contre pour le traitement la partie de traitement des données il n'aime pas le rajout de sheets(""). ( en rouge)

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
Sub Bouton12_Cliquer()


   Dim strTemp As String, Chemin As String, Fichier As String
    Dim MyDataObject As DataObject
 
    Chemin = ThisWorkbook.Path
 
    Open Chemin & "\" & "bubu.csv" For Binary As #1
        strTemp = Space$(LOF(1)) 'lecture du fichier d'un coup
        Get #1, , strTemp
 
        Set MyDataObject = New DataObject
        MyDataObject.SetText strTemp  'détermine le texte à mettre
        MyDataObject.PutInClipboard     'dans le presse-papier
        Sheets("test2").Range("e10").PasteSpecial
    Close #1
 
    MyDataObject.Clear
    Set MyDataObject = Nothing

            
        Sheets("test2").Range("e10:e3000").Select
    Selection.TextToColumns Destination:=Range("e10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
        
        
        Sheets("test2").Range("e10:e3000").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False




End Sub

erreur d'exécution 1004

le méthode select de la classe range a échoué

**mattchoco** · 17/08/2013, 22h03

c'est bon j'ai trouvé en farfouillant ,

il manquait un .Activate pour le select.

**mattchoco** · 18/08/2013, 16h55

Envoyé par AlainTech

C'est probablement bien là l'origine du problème.

Tu me donnes l'impression de quelqu'un qui voudrait rouler en voiture sans apprendre à conduire.

Si ton but est de recevoir du code tout fait, sans devoir t'investir un minimum, il me semble normal que tu te sois déjà fait "remonter les bretelles".

Maintenant, dis-nous quel est ton choix?
Commencer à apprendre ou continuer à râler parce que les réponses qu'on te donne ne te conviennent pas parce que tu ne les comprends pas.

c'est parfait, c'est exactement ce que je voulais que tu écrives. je m'attendais à ça. Au moins les choses sont dites clairement.

alors regarde bien les différents topics que j'ai créé dont celui là, il y a un certain boulot, pour comprendre , adapter et faire vivre les bout de codes et les coups de main qu'on a bien voulu me donner.

regardes vraiment tout ce qui a été posté par moi et les autres, tu verras qu'il y a une vrai évolution. d'autre part et pour rebondir sur un autre pic je peux t'assurer que la fonction "recherche" marche à merveille chez moi. ça donne des pistes, des idées, ça permet de débloquer, d'apporter des améliorations mais ça ne fait pas tout.

75% du boulot est fait ici chez moi sur mon pc, et je peut te dire qu'il ya un paquet de versions. mais les 25% apportés par les autres, je suis incapable de faire ça. désolé de pas être pro là dedans j'ai besoin de réel coup de main de gens compétent, je n'ai nul besoin d'aigris qui me disent de respecter les règles de fonctionnement d'excel et que tout marchera..

si vous ne voulez pas aidez des débutants, c'est votre problème mais dites le d'entrée. en tout cas bravo, c'est vraiment une sale mentalité.

retourne lire également le post sur le " remonter les bretelles", si je retrouve le topic je t'enverrais le lien. ma demande était clair et propre, une demande de coup de main et pas de "boulot tout fait", la remarque était pour dire " ne surcharge pas ton message avec des fichiers joint, tu les apportera en derniers recours".

si votre bête noire sont les gens qui viennent demander du tout-cuit, et ça je le comprend complètement, tu te trompes de client.

**mattchoco** · 18/08/2013, 17h11

et merci d'avoir laisser les deux derniers messages pour pouvoir parler en toute clarté.

aucune ironie dans mon message.

**mattchoco** · 18/08/2013, 18h46

les gros soucis ont l'air d'être réglés. Merci à tout le monde.

il reste un petit point .

lorsque je relance la macro une seconde fois, les valeurs sont modifiées bizarrement..

ci dessous , le premier tableau montre les valeurs présentes dans le csv
le second, les valeurs importées dans le xls par la macro

le troisième, les valeurs lorsque la macro est lancé une deuxième fois à la suite.
les soucis apparaissent sur la première colonne, le séparateur décimal disparait complètement.

a ce stade il faut que je ferme tout et que je ré-ouvre pour relancer la macro et avoir à nouveau les bons résultats du tableau 2.

[IMG]

[/IMG

]

alors, y a-t-il quelquechose dans le code pour "remettre à zéro", réinitialiser je ne sais quoi pour ne plus avoir ce problème. ci dessous, le code en question :

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
Sub Bouton12_Cliquer()
 
 
   Dim strTemp As String, Chemin As String, Fichier As String
    Dim MyDataObject As DataObject
 
    Chemin = ThisWorkbook.Path
 
    Open Chemin & "\" & "bubu.csv" For Binary As #1
        strTemp = Space$(LOF(1)) 'lecture du fichier d'un coup
        Get #1, , strTemp
 
        Set MyDataObject = New DataObject
        MyDataObject.SetText strTemp  'détermine le texte à mettre
        MyDataObject.PutInClipboard     'dans le presse-papier
        Sheets("test2").Range("E10").PasteSpecial
    Close #1
 
    MyDataObject.Clear
    Set MyDataObject = Nothing
 
        Sheets("test2").Activate
 
        Range("E1:E3000").NumberFormat = "0"
        Range("F1:F3000").NumberFormat = "0.000"
 
        Range("E10:E3000").Select
    Selection.TextToColumns Destination:=Range("E10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
 
        Range("E1:H3000").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 
End Sub

pour info j'ai essayé de vider le presse papier en fin de macro, mais ça n'a pas apporté de changement.

**clementmarcotte** · 18/08/2013, 19h31

Bonjour,

Cela confirme mon opinion initiale "Vieux c'est mieux".

**mattchoco** · 18/08/2013, 19h43

ça je suis prêt à te croire malheureusement avec ton lien je suis incapable de me débrouiller tout seul, c''est un peu chinois pour moi.

lien qui n'est plus d'ailleurs?

**mattchoco** · 18/08/2013, 20h00

ci joint le xls avec la macro dans le premier onglet

et un csv-type à traiter.

**AlainTech** · 18/08/2013, 20h53

Bonjour,

Que penses-tu de ce code? Sans la moindre transformation du contenu.

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Bouton12_Cliquer()
 
  Dim Chemin As String, Fichier As String
 
  Chemin = ThisWorkbook.Path
  Fichier = "bubu.csv"
 
  Workbooks.OpenText Chemin & Application.PathSeparator & Fichier, local:=True
 
End Sub

Ce qui prouve bien que tu aurais dû, dès que je te l'ai proposé, poster le fichier csv pour nous permettre de faire des tests dessus.

Et, pour en revenir à ton problème initial de SaveAs:

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
Sub Bouton12_Cliquer()
 
  Dim Chemin As String, FichierSource As String, FichierXls As String
  Dim iPositionPoint As Integer
  Dim wbkSource As Workbook
  Dim wbkDest As Workbook
 
  Chemin = ThisWorkbook.Path
  FichierSource = "bubu.csv"
  iPositionPoint = InStrRev(FichierSource, ".")
  FichierXls = Left(FichierSource, iPositionPoint) & "xls"
 
  Workbooks.OpenText Chemin & Application.PathSeparator & FichierSource, local:=True
  Set wbkDest = ActiveWorkbook
  wbkDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & FichierXls, FileFormat:=xlWorkbookNormal
 
End Sub

Edit: Petite modification du code pour prévenir une éventuelle question suivante.
Attention, ce code a été écrit pour XL 2003. A adapter pour XL 2010.