Microsoft 365 [RÉSOLU] Générer un tableau au nombre de lignes et colonnes variable

Poptar

XLDnaute Nouveau
Bonjour à toutes et tous,

Je suis en train de travailler sur la création d'un emploi du temps.
Pour résumer la situation, je souhaite générer des blocs colorés sur un onglet Excel à partir de données tirées d'un autre onglet.
Onglet source: "Emploi du temps"
Onglet de destination des blocs: "Blocs horaires'
J'imagine que cela nécessite une macro... donc aucune chance que j'y arrive :(

L'objectif est de générer des blocs dont la largeur (nombre de lignes) est égale au nombre de participants.
La longueur (nombre de colonnes) sera égale au nombre d'intervalles de 15 minutes.
(voir onglet : "Blocs horaires (exemple)"

J'ai besoin que ces blocs soient espacés d'une ligne et que dans la première cellule de chaque bloc (1ère ligne/1ère colonne du tableau) il y soit inscrit le nom du cours... Et si possible, que chaque bloc soit de couleur différentes (bon là, je pousse peut-être le bouchon un peu trop loin :D )

Ci-joint le fichier exemple.

Le but final de cet exercie est de pouvoir imprimer ces blocs pour pouvoir les découper et arranger sur une grille horaire.

J'espère que c'est assez clair, dans tous les cas je pourrai ré-expliquer si il y a des questions.

Merci d'avance :)
 

Pièces jointes

  • Emploi du Temps - exemple.xlsm
    36.4 KB · Affichages: 12
Solution
Bonjour Poptar, Monptipiton, fanfan38,

Une autre solution avec cette macro dans le code de la 2ème feuille du fichier joint :
VB:
Private Sub Worksheet_Activate()
Dim lig&, i&, x
Application.ScreenUpdating = False
Cells.Clear 'RAZ
lig = 1
With Sheets("Emploi du Temps").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        x = .Cells(i, 1) 'mémorise
        .Cells(i, 1) = ""
        .Cells(i, 1).Copy Cells(lig, 1).Resize(.Cells(i, 2), .Cells(i, 4)) 'copier-coller
        Cells(lig, 1) = x
        .Cells(i, 1) = x
        lig = lig + .Cells(i, 2) + 1
    Next
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

A+

Monptipiton

XLDnaute Nouveau
Bonjour,

Et bien... au taf ! Excellente opportunité de se former au VBA ;)

Dans l'ordre, à coder (une solution parmi d'autres) :
- Créer un bouton sur la feuille source qui va créer la mise en forme sur la feuille de destination (onglet développeur -> Insérer -> bouton activeX)

- Lui changer son titre :
Click droit -> Propriété -> changer caption en "Créer blocs horaires"

- Lui affecter du code :
Click droit -> Visualiser le code -> Insérer call Macro, puis passer dans un module (en créer un si nécessaire) et taper sub Macro et Enter

Il est possible de mettre des commentaires dans le code en commençant par '
'Ceci est un commentaire qui ne s'exécutera pas mais qui permettra de se comprendre

- Déclarer les variables :
Dim Nomdelavariable as Typedelavariable -> dim i as long, ShEdT as sheets, etc.

- Affecter une valeur aux variables objets :
set ShEdT = ThisWorkBook.Sheets("Emploi du Temps")

- Déclarer une variable particulière : un array ( dim Nomdel'array() )
(Un tableau qui n'a pas d'interface graphique qui permet d'aller bcp plus vite quand on boucle dessus)

- Faire un "copier-coller" de la plage de cellule contenant les données (range en anglais) à l'array :
Tablo = Sheets("Emploi du Temps").range("A1").currentregion.value

- Désactiver le rafraichissement d'écran qui ralentirait la macro

- RAZ de la feuille de destination :
Sheets(Nomdelafeuillededestination).cells.delete shift :=xlup

- Boucler sur l'array par ligne avec une boucle for :
for i = 1 to ubound(tablo, 1)...

- Boucler sur l'array par colonne toujours avec une boucle for :
for j = 1...

- Définir la variable CelluleTitre (une range) que l'on prendra soin de déclarer en début de macro (dim) :
Set Plage = ShEdT.Range(Cells(i, j), Cells(i, j))

- Mettre en place un with range(range à mettre en forme) qui permettra d'alléger et éclaircir le code :
with sheets(...).range(cells(cellulededépart en ligne, colonne), cellule d'arrivée pareillement)

- Mise en forme de la couleur, des traits, etc.
-> interior.color = CelluleTitre .Interior.Color
-> with .borders(xlEdgeLeft) (mais aussi top, bottom, etc.) -> .linestyle et .weight

Pour trouver les propriétés à changer : onglet développeur -> enregistrer une macro (qui se situera dans un module vba) -> Faire une mise en forme -> Arrêter l'enregistrement -> Comprendre les lignes de code créées -> Faire des essais dans une sub test pour être sûr qu'on obtiendra le résultat souhaité

Pour exécuter la macro en pas à pas : F8
Pour mettre un point d'arrêt sur une ligne : F9
Pour exécuter la macro d'un coup : F5
Pour renvoyer dans la console la valeur d'une variable (et s'assurer au passage de la syntaxe) : debug.print Unelignedecode

Voilà. Une trame à suivre, et des des mots clés pour faire des recherches et comprendre de quoi il en retourne.

Après rien n'empêche d'alimenter ce fil pour montrer ton code et obtenir des conseils ;)

@+
 

job75

XLDnaute Barbatruc
Bonjour Poptar, Monptipiton, fanfan38,

Une autre solution avec cette macro dans le code de la 2ème feuille du fichier joint :
VB:
Private Sub Worksheet_Activate()
Dim lig&, i&, x
Application.ScreenUpdating = False
Cells.Clear 'RAZ
lig = 1
With Sheets("Emploi du Temps").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        x = .Cells(i, 1) 'mémorise
        .Cells(i, 1) = ""
        .Cells(i, 1).Copy Cells(lig, 1).Resize(.Cells(i, 2), .Cells(i, 4)) 'copier-coller
        Cells(lig, 1) = x
        .Cells(i, 1) = x
        lig = lig + .Cells(i, 2) + 1
    Next
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

A+
 

Pièces jointes

  • Emploi du Temps(1).xlsm
    45 KB · Affichages: 14

Poptar

XLDnaute Nouveau
Bonjour!

Merci à vous trois pour vos solutions proposées.
Faut que je regarde de plus près ;)

Merci Monptipiton pour toutes tes directives et conseils. Je vais essayer de les suivre, ce sera pour moi un gros challenge (et donc une belle récompense) d'arriver à le faire toute seule.
J'ai plus qu'à retrousser mes manches maintenant !

fanfan38, job75 : Un gros merci à tous les deux pour vos solutions prêtes à l'emploi. C'est sûr que ça va me permettre de débloquer ma situation dans l'immédiat.

Bonne journée :)
 

Discussions similaires

Statistiques des forums

Discussions
311 710
Messages
2 081 781
Membres
101 817
dernier inscrit
carvajal