Discussion :

[persjussysylvain]

Bonjour,

J'ai un tableau avec des prénoms et des dates pour gérer les présences
Je voudrais lorsque j'appuie sur le bouton "ajouter à la liste" que le contenu et le commentaire de la cellule active soit ajouté au fichier texte "Liste changements"
J'ai réussi à écrire un code qui ajoute le contenu de la cellule dans le fichier texte
MAIS la cellule est nommé dans le code
MAIS à chaque fois que j'appuie sur le bouton, il efface ce qui a été écrit précédemment : je voudrais que le contenu et le commentaire soient rajoutés en haut de page
MAIS je ne sais pas comment rajouté le commentaire de la cellule

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
Private Sub CommandButton3_Click()
 
 
    On Error GoTo Erreur
 
    Dim Chaine As String
 
    Dim Fichier As String
 
    Fichier = "q:\commun\ListeChangements.txt"
 
    Dim f As Integer
 
    f = FreeFile
 
    Open Fichier For Output As #f
 
 
 
      Print #f, Cells(3, 1)
 
 
 
    Close #f
 
    MsgBox "Les cellules ont été sauvegardées dans " & Fichier
 
    Exit Sub
 
Erreur:
 
    MsgBox "Le fichier de sortie est inaccessible"
 
 
End Sub

Pourriez-vous svp m'aider à régler ces problèmes

Voici mon fichier joint (j'ai ajouté un bouton "envoyer mail" car le voudrais pouvoir envoyer la liste à la secrétaire)

Je vous remercie beaucoup

Cordialement

[Invité]

Le code ci-dessous ne règle que votre problème d'alimentation de votre fichier texte.
J'ai ajouté une ligne de code pour colorier la cellule qui a été sélectionnée afin de vous souvenir de ce qui a été transmis. Un bouton (à ajouter) efface les couleurs.

Dans votre module Feuil1

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
 
Option Explicit
 
Private Sub BoutonRazCouleurs_Click()
       ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
End Sub
 
Private Sub CommandButton1_Click()
 
End Sub
 
Private Sub CommandButton3_Click()
 
Dim Chaine As String
Dim Fichier As String
 
    On Error GoTo Erreur
 
    Fichier = "q:\commun\ListeChangements.txt"
 
 
    If ActiveCell.Row < 3 Then Exit Sub
 
    With ActiveCell
        If Not (.Comment Is Nothing) Then
              Chaine = Cells(ActiveCell.Row, 1) & "," & Cells(2, ActiveCell.Column) & "," & .Comment.Text
        Else
              Chaine = Cells(ActiveCell.Row, 1) & "," & Cells(2, ActiveCell.Column)
        End If
 
        .Interior.Color = RGB(255, 255, 0)
 
    End With
 
    AjouterUneLigneDansFichierTexte Fichier, Chaine
 
   ' MsgBox "Les cellules ont été sauvegardées dans " & Fichier
 
    Exit Sub
 
Erreur:
 
    MsgBox "Le fichier de sortie est inaccessible"
 
 
End Sub

Dans un module standard

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
 
Option Explicit
 
 
Sub AjouterUneLigneDansFichierTexte(CheminComplet As String, ContenuTexte As String)
 
Dim InputData As Variant
Dim MesDonnees() As Variant
Dim LigneEnCours As Long
 
Dim Fs
 
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Open CheminComplet For Input As #1
 
        LigneEnCours = 0
        Do While Not EOF(1)
           Line Input #1, InputData
           If InputData <> "" Then
                ReDim Preserve MesDonnees(LigneEnCours)
                MesDonnees(LigneEnCours) = InputData
                LigneEnCours = LigneEnCours + 1
           End If
        Loop
 
        ReDim Preserve MesDonnees(LigneEnCours + 1)
        MesDonnees(LigneEnCours + 1) = ContenuTexte
 
        Close #1
 
        Open CheminComplet For Output As #1
 
        For LigneEnCours = LBound(MesDonnees) To UBound(MesDonnees)
            If MesDonnees(LigneEnCours) <> "" Then Print #1, MesDonnees(LigneEnCours)
        Next LigneEnCours
 
 
        Close #1
 
        Set Fs = Nothing
 
End Sub

[pijaku]

Bonjour,

Eric,
Je me permet de modifier légèrement ta réponse.
Dans la demande, il y avait également cet aspect :

je voudrais que le contenu et le commentaire soient rajoutés en haut de page

J'ai également ajouté une variable FreeFile, juste au cas ou...
De plus le "FS" (FileSystemObject) est inutile ici.
Donc :

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
 
Option Explicit
 
Sub AjouterUneLigneDansFichierTexte(CheminComplet As String, ContenuTexte As String)
 
Dim InputData As Variant
Dim MesDonnees() As Variant
Dim LigneEnCours As Long
Dim NumFic AS Integer
'Dim Fs
 
        NumFic = FreeFile
        'Set Fs = CreateObject("Scripting.FileSystemObject")
        Open CheminComplet For Input As #NumFic
 
        LigneEnCours = 0
 
        ReDim Preserve MesDonnees(LigneEnCours)
        MesDonnees(LigneEnCours) = ContenuTexte
 
        Do While Not EOF(1)
           Line Input #NumFic, InputData
           If InputData <> "" Then
                LigneEnCours = LigneEnCours + 1
                ReDim Preserve MesDonnees(LigneEnCours)
                MesDonnees(LigneEnCours) = InputData
           End If
        Loop
 
 
        Close #NumFic
        NumFic = FreeFile
 
        Open CheminComplet For Output As #NumFic
 
        For LigneEnCours = LBound(MesDonnees) To UBound(MesDonnees)
            'Ici aussi le test est inutile, tu l'as fait plus haut.
            'If MesDonnees(LigneEnCours) <> "" Then Print #NumFic, MesDonnees(LigneEnCours)
            Print #NumFic, MesDonnees(LigneEnCours)
        Next LigneEnCours
 
 
        Close #NumFic
 
        'Set Fs = Nothing
 
End Sub

[Invité]

Bonjour Franck,

Tu as raison pour FS, je me suis servi d'un ancien code qui lisait un fichier txt et injectait le contenu et renommait dans un nouveau répertoire.

[pijaku]

Tu as raison pour FS, je me suis servi d'un ancien code

C'est ce qui arrive lorsque l'on répond le matin avant de prendre un café.

A++

[persjussysylvain]

Bonsoir,

C'est parfait, Merci
Est-il possible de noter également le "x"
Comment faites vous pour préciser le tableau et trouver la date et le prénom ?
Quel code dois-je modifier pour adapter ce code à un tableau plus grand ?
Je vous remercie beaucoup

Cordialement