Projet Export CSV Structuré via Maco

Version imprimable

10/01/2012, 12h33
Tonton_glenn

1 pièce(s) jointe(s)

Projet Export CSV Structuré via Maco

Salut à tous (et toutes),

Permettez moi de présenter en premier lieu tous mes meilleurs voeux à ceux qui me liront.

Cette année est placé sous le signe du défi. En effet pour ceux qui n'aurait pas froid aux yeux, j'ai un petit projet à vous soumettre pour lequel j'aurais besoins des compétences des plus acharnés d'entre vous. Etant un bille en excel (je commence à apprendre le vb) mais ayant des idées pleins la tête, je me heurte à quelques petit problèmes de competences.

Voici mon projet :

A partir de ca :

http://img692.imageshack.us/img692/7687/capt1a.png

Je souhaite pouvoir exporter un fichier CSV via une macro qui aurait cette tronche la, afin de pouvoir derriere le traiter avec un vbs à bibi :

http://img88.imageshack.us/img88/1669/capt2v.png

Alors j'ai bien une petite idée dans le cahier des charges, et cela ressemble à :

- Je prend une cellule de reference (ex: C4)
- Je lis les données qui sont a gauche, la premiere colone c'est le nom, la 2eme le prenom.
- Moi meme etant la cellule concernant les droits
- La case au dessus de moi est un dossier de niveau 3
- La case encore au dessus est un dossier de niveau 2. Cette case peut etre vide (car fusion de cellule) alors je parcours les case sur la gauche jusqu'a tomber sur une valeur, ce sera alors la valeur de mon dossier N2
- La Case la plus haute est le dossier N1. Meme principe,Cette case peut etre vide (car fusion de cellule) alors je parcours les case sur la gauche jusqu'a tomber sur une valeur, ce sera alors la valeur de mon dossier N1.
- Je repete la meme operation mais cette fois ci en me deplacant sur la case sur ma droite, etc, jusqu'à tomber sur une case vide.
- Une fois sur la case vide je refait le tout mais sur la ligne du dessous

Vous l'aurez compris, il s'agit la d'un projet assez complexe...

En premier lieu je souhaiterai avoir votre avis sur la faisabilite de la chose, si je suis parti dans la bonne direction (s'il n'y a pas plus simple) et je preciserai que je souhaiterai garder la forme qu'à le tableau (niveau visuel).

Je solicite donc vos conseils et prouesses avec grand interet vous remercie de l'attention que vous portez à ma demande ;)

PS : Je vous ai egalement joint un exemple de fichier avec 2 feuilles vous montrant un peu ce à quoi je souhaite arriver si jamais je n'avais pas ete assez clair 8-)

Bonjour,

Le code suivant effectue ce que tu désires.
Le résultat est affiché dans un popup et inscrit dans le fichier c:\temp\test.txt

Par contre il ne gère pas l'inscription de la ligne de titre vue que les noms des champs ne sont pas dans le tableau

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
Option Explicit
 
Public Sub ExportCSV()
    Dim noLig           As Integer
    Dim noCol           As Integer
    Dim noColDeb        As Integer
    Dim noColMax        As Integer
    Dim noLigTitreMax   As Integer
    Dim noLigTitre      As Integer
    Dim noColTitre      As Integer
    Dim ficCSV          As String
    Dim FSO             As New FileSystemObject ' Référence Microsoft Scripting Runtime
    Dim myFile          As TextStream
    '
    noLig = 4               ' Première ligne de données
    noLigTitreMax = 3       ' Dernière ligne de titre
    noColDeb = 3            ' Première colonne de données
    noColMax = 6            ' Dernière colonne de données
    '
    ' Pour toutes les lignes à traiter
    ficCSV = ""
    While Not IsEmpty(Cells(noLig, 1))
        '
        ' Pour toutes les colonnes de connées
        noCol = noColDeb
        While noCol <= noColMax
            ficCSV = ficCSV & Cells(noLig, 1) & ";" & Cells(noLig, 2)
            ficCSV = ficCSV & ";" & Cells(noLig, noCol)
            '
            ' Pour toutes les lignes de titre
            noLigTitre = noLigTitreMax
            While noLigTitre <> 0
                '
                ' Recherche du titre
                noColTitre = noCol
                Do
                    '
                    ' Jusqu'à la colonne contenant le titre
                    If Not IsEmpty(Cells(noLigTitre, noColTitre)) Then
                        ficCSV = ficCSV & ";" & Cells(noLigTitre, noColTitre)
                        Exit Do
                    Else
                        noColTitre = noColTitre - 1
                    End If
                Loop
                noLigTitre = noLigTitre - 1
            Wend
            ficCSV = ficCSV & vbCrLf
            noCol = noCol + 1
        Wend
        '
        noLig = noLig + 1
    Wend
    '
    MsgBox ficCSV
    Set myFile = FSO.CreateTextFile("c:\temp\test.txt", True)
    myFile.Write ficCSV
    myFile.Close
    '
    Set myFile = Nothing
    Set FSO = Nothing
End Sub

.....je suis en plein rêve ! :lol:

MERCI !!!! Ca fonctionne du feu de dieu, c'est exactement ce que je souhaitais !

Une petite modification pour l'export csv :

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
 
Sub ExportCSV_txt()
    Dim noLig           As Integer
    Dim noCol           As Integer
    Dim noColDeb        As Integer
    Dim noColMax        As Integer
    Dim noLigTitreMax   As Integer
    Dim noLigTitre      As Integer
    Dim noColTitre      As Integer
    Dim ficCSV          As String
 
    noLig = 4               ' Première ligne de données
    noLigTitreMax = 3       ' Dernière ligne de titre
    noColDeb = 3            ' Première colonne de données
    noColMax = 6            ' Dernière colonne de données
    '
    ' Pour toutes les lignes à traiter
    ficCSV = ""
    While Not IsEmpty(Cells(noLig, 1))
        '
        ' Pour toutes les colonnes de connées
        noCol = noColDeb
        While noCol <= noColMax
            ficCSV = ficCSV & Cells(noLig, 1) & ";" & Cells(noLig, 2)
            ficCSV = ficCSV & ";" & Cells(noLig, noCol)
            '
            ' Pour toutes les lignes de titre
            noLigTitre = noLigTitreMax
            While noLigTitre <> 0
                '
                ' Recherche du titre
                noColTitre = noCol
                Do
                    '
                    ' Jusqu'à la colonne contenant le titre
                    If Not IsEmpty(Cells(noLigTitre, noColTitre)) Then
                        ficCSV = ficCSV & ";" & Cells(noLigTitre, noColTitre)
                        Exit Do
                    Else
                        noColTitre = noColTitre - 1
                    End If
                Loop
                noLigTitre = noLigTitre - 1
            Wend
            ficCSV = ficCSV & vbCrLf
            noCol = noCol + 1
        Wend
        '
        noLig = noLig + 1
    Wend
    '
 
 
'-- Construction du nom du fichier CSV
'--------------------------------------
DossierFichierExcel = ActiveWorkbook.Path
 
DateSystème = Date
DateSSAAMMJJ = Mid(DateSystème, 7, 4) & Mid(DateSystème, 4, 2) & Mid(DateSystème, 1, 2)
 
NomFichierCSV = "Import_Droits_Dossiers_" & Range("C2").Value
NomFichierCSV = NomFichierCSV & "_" & DateSSAAMMJJ & ".CSV"
 
'-- Création du fichier CSV
'---------------------------
    Separateur = ";"
 
 
ThePath = ThisWorkbook.Path & "\" & NomFichierCSV
TheFile = Application.GetSaveAsFilename(ThePath, "CSV ,*.csv")
If TheFile = False Then Exit Sub
 
Open TheFile For Output As #1
 
'Open DossierFichierExcel & "\" & NomFichierCSV For Output As #1
 
Print #1, ficCSV '= " "
 
Close
 
End Sub

En tout cas, bravo et merci mille fois pour avoir pris du temps pour me répondre, quelle réactivité, ca fais super plaisir ! :ccool:

A bientôt

PS : il devrait y avoir des bouton +1000 car +1 ce n'est pas assez mérité :mrgreen: