1ère création de macro

Version imprimable

Voir 40 message(s) de cette discussion en une page

14/03/2019, 13h49
manafan

1ère création de macro

Bonjour à tous !
Je ne sais pas s'il faut passer obligatoirement par la page de présentation, je n'ai rien lu à ce sujet. Si tel est le cas n'hésitez pas à me le dire.

Voici l'objet de ma discussion : je souhaiterai créer une macro qui me permettrait de copier automatiquement des noms qui se trouvent dans plusieurs colonnes d'une feuille d'un classeur intitulé "Liste des élèves par classe" vers une autre feuille intitulée "Planning devoirs faits" à un endroit précis du tableau de cette feuille en fonction du contenu des 3 cellules qui se trouvent à gauche des noms dans la première feuille et qui ont été remplies par liste déroulante.

A chaque fois que je rajouterais un nom dans une colonne de la 1ere feuille, je voudrais qu'il soit collé au bon endroit dans la seconde feuille et donc que la macro réinsère des lignes s'il le faut et qu'elle colle également le numéro de la classe qui se trouve sur la 1ère ligne de la 1ère feuille dans la colonne appropriée de la seconde.

J'ai déjà fait un peu de programmation mais je ne connais pas la syntaxe et j'ai du mal à trouver un pdf ou une vidéo qui m'aiderait à démarrer cette macro.

Si des âmes charitables veulent venir à mon secours je suis preneur !
Le but est de bien comprendre et décortiquer cette macro pour pouvoir m'en resservir et la réadapter ultérieurement ...

Merci par avance !
manafan
14/03/2019, 15h27
Menhir

Ta demande est difficile à comprendre sans connaitre ta structure de données.
Je pense que tu devrais afficher une copie d'écran de tes données sources et destination pour pouvoir comprendre ce que tu souhaites.
14/03/2019, 15h54
manafan

1 pièce(s) jointe(s)

Je mets cela. Mais comme il ne fallait pas trop mettre de pièce jointe sur le premier message je me suis abstenu.

Je ne comprends pas ... que ce soit en insertion directe ou en pièce jointe, j'ai un message d'erreur sur mes captures d'écran. Je ne peux les ajouter à la liste des fichiers.
Je mets le fichier xlsm en attendant qui lui a bien voulu être ajouté ... incompréhensible ...

Je suis en train de faire une ébauche de l'algorithme sur papier de ce que ça donnerait en français. Je peux le poster si vous voulez ...
14/03/2019, 16h14
BENNASR

Bonsoir monsieur
Peut être si tu réorganises tes données de la façon suivante
Nom de l'élève / Jour /Créneau/Semaine/Date/Classe
puis tu insère un tableau croisé dynamique avec des segments et comme ça tu peux consulter tes données soit par classe soit par Créneau, par semaine ou par date
avec une bonne présentation
14/03/2019, 16h23
BENNASR

1 pièce(s) jointe(s)

un exemple
14/03/2019, 16h40
manafan

J'y avais bien pensé mais le problème est qu'avec un tableau croisé dynamique, les noms vont se retrouver en tête de ligne ou de colonne alors que je souhaiterai qu'ils se retrouvent à l'intérieur du tableau.
14/03/2019, 17h04
manafan

oui je viens de voir votre exemple. Effectivement c'est une alternative mais je voudrais qu'à l'intérieur du tableau soient inscrits les noms et non des nombres.
D'où la macro et mon problème.
Merci pour votre réponse néanmoins.

Bonjour

Il faudra remplir les cases des élèves avec répétition dans la feuille liste des élèves par classe

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
Sub Copiesdesnoms()
Dim Jour As String, Creneau As String, Eleve As String, Classe As String
Dim Lastlig As Long, i As Long
Dim Col As Integer, k As Integer
 
With Feuil1
    For k = 1 To 26 Step 5
        Lastlig = .Cells(.Rows.Count, k).End(xlUp).Row
        If Lastlig > 2 Then
            Classe = .Cells(1, k).Text
            For i = 3 To Lastlig
                Eleve = .Cells(i, k).Value
                Jour = .Cells(i, k + 1).Value
                Creneau = .Cells(i, k + 2).Value
                semaine = .Cells(i, k + 3)
                With Feuil2
                    Set c = .Rows(1).Find(Jour, LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Col = c.Column
                        Set c = .Columns(1).Find(Creneau, LookIn:=xlValues, lookat:=xlWhole)
                        If Not c Is Nothing Then
                            Col = Col + IIf(semaine = "A", 2, 6)
                            .Cells(c.Row, Col).Value = Eleve
                            .Cells(c.Row, Col + 1).Value = Classe
                        End If
                    End If
                End With
            Next i
        End If
    Next k
End With
End Sub

14/03/2019, 22h16
manafan

Merci mercatog !
Alors je me doutais que je serai obligé de remplir les champs vides des noms.

Je me suis penché sur ta proposition et j'ai plusieurs interrogations :

1) Les élèves pour lesquels le champs semaine est vide, ne sont placés alors qu'en fait s'il est vide c'est que cela doit apparaitre pour les 2 semaines A et B

2) Je ne sais pas pourquoi à l’exécution de la macro sur le tableau "Mardi", cela me remplace "Semaine B" par "A"

3) les élèves qui sont positionnés sur le même jour et le même créneau dans a feuille source ne sont pas placés dans la feuille de destination vu que la cellule est du coup déjà occupée. Quelle fonction utiliser pour insérer une ligne sous l'élève déjà placé ?
Ne serait-je pas mieux, du coup, à faire une feuille par jour du coup sinon pour certains tableaux des lignes vont être insérées pour rien ....

J'ai commencé à étudier la syntaxe : Dim -> déclaration de variable OK que signifie "As string" ?
Tout ce qui est If et for Ok mais alors les autres fonctions que tu utilises restent pour moi pour l'instant très obscur. J'ai encore du boulot ...

Merci pour ce début en tout cas, je découvre la syntaxe :)
15/03/2019, 09h51
Menhir

Citation:

Envoyé par manafan

J'ai commencé à étudier la syntaxe : Dim -> déclaration de variable OK que signifie "As string" ?

https://docs.microsoft.com/fr-fr/off.../dim-statement

Citation:

Tout ce qui est If et for Ok mais alors les autres fonctions que tu utilises restent pour moi pour l'instant très obscur.

Dans l'éditeur, tu places ton curseur sur l'élément que tu ne comprends pas et tu appuies sur la touche F1.
Tu accèderas à l'aide VBA en ligne concernant cet élément.

Mais si tes interrogations portent sur TOUT (excepté Dim et If), peut-être devrais-tu passer un peu de temps à te former pour connaitre les bases.
http://bidou.developpez.com/article/VBA/

Bonjour
Je suis entièrement d'accord avec Menhir. :plusser:

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
Option Explicit
 
Sub Copiesdesnoms()
Dim Jour As String, Creneau As String, Eleve As String, Classe As String, Semaine As String
Dim Col As Integer, k As Integer
Dim Lastlig As Long, i As Long
Dim Doub As Boolean
Dim c As Range
 
Effacer
With Feuil1
    For k = 1 To 26 Step 5
        Lastlig = .Cells(.Rows.Count, k + 1).End(xlUp).Row
        If Lastlig > 2 Then
            Classe = .Cells(1, k).Text
            For i = 3 To Lastlig
                If .Cells(i, k).Value <> "" Then Eleve = .Cells(i, k).Value
                Jour = .Cells(i, k + 1).Value
                Creneau = .Cells(i, k + 2).Value
                Semaine = .Cells(i, k + 3)
                With Feuil2
                    Set c = .Rows(1).Find(Jour, LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Col = c.Column
                        Set c = .Columns(1).Find(Creneau, LookIn:=xlValues, lookat:=xlWhole)
                        If Not c Is Nothing Then
                            Doub = Semaine = ""
                            Col = Col + IIf(Semaine = "B", 6, 2)
                            EcrireEleve .Cells(c.Row, Col), Eleve, Classe
                            If Doub Then EcrireEleve .Cells(c.Row, Col + 4), Eleve, Classe
                        End If
                    End If
                End With
            Next i
        End If
    Next k
End With
MsgBox "Transcription terminée..."
End Sub
 
Private Sub EcrireEleve(ByVal Rng As Range, ByVal Elv As String, ByVal Cla As String)
 
With Rng
    If .Value = "" Then
        .Resize(, 2).Value = Array(Elv, "'" & Cla)
    Else
        .Value = .Value & Chr(10) & Elv
        .Offset(, 1).Value = .Offset(, 1).Value & Chr(10) & Cla
    End If
End With
End Sub
 
Private Sub Effacer()
Dim i As Integer
 
With Feuil2
    For i = 4 To 44 Step 10
        .Cells(5, i).Resize(29, 2).ClearContents
        .Cells(5, i + 4).Resize(29, 2).ClearContents
    Next i
End With
End Sub

15/03/2019, 11h23
manafan

Merci beaucoup mercatog !

Tout à l'air de fonctionner comme je le souhaitais. Super boulot ! Un énorme bravo et merci :):)

J'ai commencé à étudier le pdf qu'il y avait avec le lien de Menhir. Me former, c'est bien mon intention !
Je vais regarder ta macro soigneusement.

Je peux revenir vers toi si je n'arrive pas à décrypter une partie ? Du coup dois-je mettre résolu ou bien est-ce que j'attends de ne plus avoir de questions ?

La logique des instructions ça va mais comme je ne connais pas encore bien la signification des instructions c'est encore très compliqué ...

Bonne journée et encore merci.
15/03/2019, 11h41
Menhir

Citation:

Envoyé par manafan

La logique des instructions ça va mais comme je ne connais pas encore bien la signification des instructions c'est encore très compliqué ...

Quelques autres références que je te conseil de mettre en favori dans ton navigateur si tu comptes continuer à faire du développement VBA :
https://docs.microsoft.com/fr-fr/off...nce/statements
https://docs.microsoft.com/fr-fr/off...r-applications
https://docs.microsoft.com/fr-fr/pre...4(v=office.15)
https://docs.microsoft.com/fr-fr/pre...7(v=office.15)
https://docs.microsoft.com/fr-FR/off...Excel.Workbook
Avec ces 5 liens, 99% de ce que tu peux avoir besoin dans du VBA Excel est accessible en moins de 3 clics.
15/03/2019, 12h45
manafan

Merci Menhir.

J'ai commencé à parcourir le pdf sur http://bidou.developpez.com/article/VBA/
Complet mais pas facile à digérer.

Les 5 liens sont en favoris !
25/03/2019, 18h07
manafan

Bonjour à tous,
j'ai tenté de modifié la fiche dont je vous ai parlé ci-dessus.

1er point : Je voudrais créer 4 feuilles sources soit une par niveau d'élève 6e-5e-4e-3e qui viendront remplir la feuille de destination.

Est-ce que la macro que mercatog a édité le 14/03 peut-être modifié de manière à ce que la macro balaie les tableaux des 4 feuilles pour aller remplir ma feuille de destination ?

J'ai (naïvement) tenté de modifier :

With Feuil1
For k = 1 To 26 Step 5

en

With Feuil1 and Feuil4
For k = 1 To 26 Step 5

mais bien évidemment ça ne fonctionne pas.

Faut-il créer une macro par feuille source ?

2e point : si je veux créer une feuille de destination pour chaque jour de la semaine, le problème est-il le même ?

Bonne fin de journée à tous.

Bonjour

Pour le 1, il suffit de paramétrer la procédure et de l'utiliser pour les feuilles sources concernées

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
Option Explicit
 
Sub CopieDesNoms()
Dim oWs As Variant
 
Effacer
For Each oWs In Array(Feuil4, Feuil1)  'ICI METTRE LES CODENAME DES FEUILLES SOURCES CONCSERNEES
    CopiesNomsomsParNiveau oWs
Next oWs
MsgBox "Transcription terminée..."
End Sub
 
Private Sub CopiesNomsomsParNiveau(ByVal Ws As Worksheet)
Dim Jour As String, Creneau As String, Eleve As String, Classe As String, Semaine As String
Dim Col As Integer, k As Integer
Dim Lastlig As Long, i As Long
Dim Doub As Boolean
Dim c As Range
 
With Ws
    For k = 1 To 26 Step 5
        Lastlig = .Cells(.Rows.Count, k + 1).End(xlUp).Row
        If Lastlig > 2 Then
            Classe = .Cells(1, k).Text
            For i = 3 To Lastlig
                If .Cells(i, k).Value <> "" Then Eleve = .Cells(i, k).Value
                Jour = .Cells(i, k + 1).Value
                Creneau = .Cells(i, k + 2).Value
                Semaine = .Cells(i, k + 3)
                With Feuil2
                    Set c = .Rows(1).Find(Jour, LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        Col = c.Column
                        Set c = .Columns(1).Find(Creneau, LookIn:=xlValues, lookat:=xlWhole)
                        If Not c Is Nothing Then
                            Doub = Semaine = ""
                            Col = Col + IIf(Semaine = "B", 6, 2)
                            EcrireEleve .Cells(c.Row, Col), Eleve, Classe
                            If Doub Then EcrireEleve .Cells(c.Row, Col + 4), Eleve, Classe
                        End If
                    End If
                End With
            Next i
        End If
    Next k
End With
End Sub
 
Private Sub EcrireEleve(ByVal Rng As Range, ByVal Elv As String, ByVal Cla As String)
 
With Rng
    If .Value = "" Then
        .Resize(, 2).Value = Array(Elv, "'" & Cla)
    Else
        .Value = .Value & Chr(10) & Elv
        .Offset(, 1).Value = .Offset(, 1).Value & Chr(10) & Cla
    End If
End With
End Sub
 
Private Sub Effacer()
Dim i As Integer
 
With Feuil2
    For i = 4 To 44 Step 10
        .Cells(5, i).Resize(29, 2).ClearContents
        .Cells(5, i + 4).Resize(29, 2).ClearContents
    Next i
End With
End Sub

25/03/2019, 21h50
manafan

Merci Mercatog.
Si je comprends bien on appelle un procédure CopiesDesNoms qui appelle une sous-procédure CopiesNomsomsParNiveau que l'on fait tourner pour chaque valeur de la variable oWs parmi les feuilles sources dont j'ai besoin ?

Pour le point n°2 : est-ce que c'est possible de dire, une fois que l'on a attribué une valeur aux variables Jour, Créneau et Semaine et donc que Jour = .Cells(i, k + 1).Value , plutôt que de démarrer par With Feuil2, faire une boucle de recherche sur le nom des feuilles ? "Si Jour = nom de la feuilx alors with feuil x set c= etc..." ou je dis des grosses bêtises ?

Worksheets(jour) donne la feuille du jour

A adapter selon commentaires

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
Option Explicit
 
Sub CopieDesNoms()
Dim oWs As Variant
 
Application.ScreenUpdating = False
Effacer
For Each oWs In Array(Feuil8, Feuil1)  'ICI METTRE LES CODENAME DES FEUILLES SOURCES CONCERNEES
    CopiesNomsomsParNiveau oWs
Next oWs
MsgBox "Transcription terminée..."
End Sub
 
Private Sub CopiesNomsomsParNiveau(ByVal Ws As Worksheet)
Dim Jour As String, Creneau As String, Eleve As String, Classe As String, Semaine As String
Dim Col As Integer, k As Integer
Dim Lastlig As Long, i As Long
Dim Doub As Boolean
Dim c As Range
 
With Ws
    For k = 1 To 26 Step 5
        Lastlig = .Cells(.Rows.Count, k + 1).End(xlUp).Row
        If Lastlig > 2 Then
            Classe = .Cells(1, k).Text
            For i = 3 To Lastlig
                If .Cells(i, k).Value <> "" Then Eleve = .Cells(i, k).Value
                Jour = .Cells(i, k + 1).Value
                Creneau = .Cells(i, k + 2).Value
                Semaine = .Cells(i, k + 3)
                If FeuilleExiste(Jour) Then
                    With Worksheets(Jour)
                        Set c = .Columns(1).Find(Creneau, LookIn:=xlValues, lookat:=xlWhole)
                        If Not c Is Nothing Then
                            Doub = Semaine = ""
                            Col = IIf(Semaine = "B", 8, 4)
                            EcrireEleve .Cells(c.Row, Col), Eleve, Classe
                            If Doub Then EcrireEleve .Cells(c.Row, 8), Eleve, Classe
                        End If
                    End With
                End If
            Next i
        End If
    Next k
End With
End Sub
 
Private Sub EcrireEleve(ByVal Rng As Range, ByVal Elv As String, ByVal Cla As String)
 
With Rng
    If .Value = "" Then
        .Resize(, 2).Value = Array(Elv, "'" & Cla)
    Else
        .Value = .Value & Chr(10) & Elv
        .Offset(, 1).Value = .Offset(, 1).Value & Chr(10) & Cla
    End If
End With
End Sub
 
Private Sub Effacer()
Dim oWs As Variant
 
For Each oWs In Array(Feuil2, Feuil4, Feuil5, Feuil6, Feuil7)    'ICI METTRE LES CODENAME des feuilles lundi, mardi,....vendredi
    oWs.Cells(5, 4).Resize(29, 2).ClearContents
    oWs.Cells(5, 8).Resize(29, 2).ClearContents
Next oWs
End Sub
 
Private Function FeuilleExiste(ByVal Tmp As String) As Boolean
 
On Error Resume Next
FeuilleExiste = Worksheets(Tmp).Index
End Function

25/03/2019, 22h46
manafan

J'essaie cela dès que j'ai un moment.

Un grand merci !
27/03/2019, 18h26
manafan

J'ai essayé cela et ça marche super ! Merci beaucoup ! J'ai juste modifié une adresse de cellule dans Private Sub Effacer() car le premier créneau horaire des feuilles de destination ne s’effaçait pas lorsque l'on exécutait plusieurs fois la macro. Je commence à déchiffrer ce qui est écrit dans la macro :D

Je voudrais faire une dernière petite chose pour parfaire le fichier : lorsque la macro s'exécute, elle copie les noms dans les 4 feuilles de destination mais problème la hauteur d'une ligne est limitée à 546 pixels ce qui veut dire que l'on ne peut pas copier plus de 27 noms dans une cellule.
C'est assez rare mais il y a des créneaux où le nombre d'élèves frise ce nombre.
Qu'est-ce que j'ai comme alternative ? Insérer une ligne en-dessous et recommencer la copie dans cette nouvelle ligne ?

Voir 40 message(s) de cette discussion en une page