Bonjour, je fais appel à vous car j'ai réaliser quelques macros, elles fonctionnent très bien cependant j'aurais voulu savoir comment optimiser leur temps d'exécution.
J'aurais aimé aussi savoir si l'on peut afficher une boite de message qui mettrait en attente l'utilisateur pendant l'exécution.
Y-a-t-il moyen de rester sur la page où on exécute la macro plutôt que de voir naviguer le curseur dans les différentes feuilles?
Je vous joins 3 macros, les plus longues:
J'aurais aimé aussi savoir si l'on peut afficher une boite de message qui mettrait en attente l'utilisateur pendant l'exécution.
Y-a-t-il moyen de rester sur la page où on exécute la macro plutôt que de voir naviguer le curseur dans les différentes feuilles?
Je vous joins 3 macros, les plus longues:
Code:
Sub Changement_de_session()
Sheets("Récap par stagiaire").Select
Selection.Activate
'si session désirée vide, message box
If Range("N2").Value = "" Then
If MsgBox("Sélectionner la session désirée") = vbOK Then Exit Sub
End If
'copie de la ligne de valeurs pour conserver ancien emplacement du stagiaire
Sheets("Récap par stagiaire").Range("AF5").Select
Selection.Copy
Sheets("Récap par stagiaire").Range("AG5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim i&
For i = 400 To 7 Step -1
Z = Sheets("Récap par stagiaire").Range("AM" & i).Value 'première ligne libre dans sessions
Y = Sheets("Récap par stagiaire").Range("AG5").Value 'ligne valeurs ancien emplacement
'si session désirée coincide avec session dispo, alors s'il y a des places, copier les valeurs
If Range("N2").Value = Range("L" & i).Value Then
If Range("O" & i).Value = 0 Then
MsgBox ("Session pleine")
Else
If Range("O" & i).Value > 0 Then
'copie des valeurs
Sheets("Suivi Sessions").Activate
Sheets("Suivi Sessions").Range("D" & Y).Resize(1, 15).Select
Selection.Copy
Sheets("Suivi Sessions").Range("D" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Suivi Sessions").Range("T" & Z).Value = Sheets("Suivi Sessions").Range("T" & Y).Value
Sheets("Suivi Sessions").Range("U" & Z).Value = Sheets("Suivi Sessions").Range("U" & Y).Value
Sheets("Suivi Sessions").Range("W" & Z).Value = Sheets("Suivi Sessions").Range("W" & Y).Value
Sheets("Suivi Sessions").Range("X" & Z).Value = Sheets("Suivi Sessions").Range("X" & Y).Value
Sheets("Suivi Sessions").Range("Z" & Z).Value = Sheets("Suivi Sessions").Range("Z" & Y).Value
Sheets("Suivi Sessions").Range("AA" & Y).Resize(1, 13).Copy
Sheets("Suivi Sessions").Range("AA" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Suivi Sessions").Range("AO" & Y).Resize(1, 7).Copy
Sheets("Suivi Sessions").Range("AO" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Suivi Sessions").Range("AW" & Y).Resize(1, 7).Copy
Sheets("Suivi Sessions").Range("AW" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Suivi Sessions").Range("BE" & Y).Resize(1, 4).Copy
Sheets("Suivi Sessions").Range("BE" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
m = Sheets("Récap par stagiaire").Range("AQ4").Value 'pour ancienne ligne concernée (gauche)
n = Sheets("Récap par stagiaire").Range("AQ5").Value 'pour haut gauche de la session
o = Sheets("Récap par stagiaire").Range("AZ5").Value 'pour haut gauche de la session
p = Sheets("Récap par stagiaire").Range("AZ4").Value 'pour ligne courante (gauche)
q = Sheets("Récap par stagiaire").Range("AS5").Value 'pour ligne haut gauche zone à droite du tableau
'copie de la ligne de formule de base sur l'ancien emplacement du stagiaire
Sheets("Suivi Sessions").Activate
Sheets("Suivi Sessions").Range("D17:BH17").Select
Selection.Copy
Sheets("Suivi Sessions").Range(m).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'tri de l'ancienne session
With Sheets("Suivi Sessions")
.Range(n).Resize(12, 57).Select
Selection.Sort Key1:=Range(n), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
'tri de la nouvelle session
Sheets("Suivi Sessions").Activate
With Sheets("Suivi Sessions")
.Range(o).Resize(12, 57).Select
Selection.Sort Key1:=Range(o), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
'désélectionner
Sheets("Suivi Sessions").Range(p).Select
Sheets("Récap par stagiaire").Activate
Sheets("Récap par stagiaire").Range("H11").Select
End If
End If
End If
Next
'actualise les places sessions
Call Actualiser_Places_Sessions
'efface session désirée
Sheets("Récap par stagiaire").Activate
Sheets("Récap par stagiaire").Range("N2").ClearContents
Sheets("Récap par stagiaire").Range("H11").Select
'message stagiaire transféré
session = "Stagiaire transféré vers la session " & Sheets("Récap par stagiaire").Range("D4").Value
MsgBox ([session])
End Sub
Code:
Sub Ajouter_à_la_session()
'si session voulue vide, message box, sinon copie des valeurs
If Range("D5").Value = "" Then
If MsgBox("Veuillez choisir une session") = vbOK Then Exit Sub
End If
'copie des valeurs
Dim i&
For i = 400 To 2 Step -1
Z = Sheets("Ajouter stagiaire").Range("U" & i).Value 'première cellule vide de la session
'si session coincide avec session dispo, et si places dispo, alors copier valeurs
If Range("D5").Value = Range("K" & i).Value Then
If Range("N" & i).Value = 0 Then
MsgBox ("Session pleine")
Else
'copie des valeurs
If Range("N" & i).Value > 0 Then
Sheets("Suivi Sessions").Range("D" & Z).Value = Range("D2").Value
Sheets("Suivi Sessions").Range("E" & Z).Value = Range("D3").Value
Sheets("Suivi Sessions").Range("F" & Z).Value = Range("D8").Value
Sheets("Suivi Sessions").Range("G" & Z).Value = Range("D9").Value
Sheets("Suivi Sessions").Range("H" & Z).Value = Range("D10").Value
Sheets("Suivi Sessions").Range("I" & Z).Value = Range("D11").Value
Sheets("Suivi Sessions").Range("J" & Z).Value = Range("D12").Value
Sheets("Suivi Sessions").Range("BH" & Z).Value = Range("D13").Value
'copier nom + prénom dans la feuille Récap
Sheets("Récap par stagiaire").Range("D2:F2") = Sheets("Ajouter Stagiaire").Range("AG3")
'Trier la session de destination
n = Sheets("Récap par stagiaire").Range("AZ5").Value
o = Sheets("Récap par stagiaire").Range("AZ4").Value
Sheets("Suivi Sessions").Activate
With Sheets("Suivi Sessions")
.Range(n).Resize(12, 56).Select
Selection.Sort Key1:=Range(n), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Range(o).Select
'remise à plat de la feuille ajouter stagiaire
Sheets("Ajouter Stagiaire").Activate
Range("X2:X16").Select
Selection.Copy
Range("D2:F2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("H11").Select
End If
End If
End If
Next
'actualiser places session
Call Actualiser_Places_Sessions
session = "Stagiaire ajouté à la session " & Range("D5").Value
MsgBox ([session])
End Sub
Code:
Sub Actualiser_Places_Sessions()
Application.CutCopyMode = False
'chercher valeurs de sessions
For i = 2 To 100
'copier toutes les références de sessions
Sheets("Ajouter stagiaire").Range("K" & i) = Sheets("Suivi Sessions").Range("C" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
'si référence de session présente, copier lieu, date, et nombre de places dispo
If Sheets("Suivi Sessions").Range("C" & Sheets("Ajouter stagiaire").Range("AC" & i).Value) <> "" Then
Sheets("Ajouter stagiaire").Range("L" & i) = Sheets("Suivi Sessions").Range("BL" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
Sheets("Ajouter stagiaire").Range("M" & i) = Sheets("Suivi Sessions").Range("BK" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
Sheets("Ajouter stagiaire").Range("N" & i) = Sheets("Suivi Sessions").Range("H" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
End If
Next i
'mise en forme du tableau de données
Sheets("Ajouter stagiaire").Activate
Sheets("Ajouter stagiaire").Range("K2").Copy
Sheets("Ajouter stagiaire").Range("K3:K100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Ajouter stagiaire").Range("L2").Select
Selection.Copy
Sheets("Ajouter stagiaire").Range("L3:L100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Ajouter stagiaire").Range("M2").Copy
Sheets("Ajouter stagiaire").Range("M3:M100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Ajouter stagiaire").Range("N2").Copy
Sheets("Ajouter stagiaire").Range("N3:N100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Ajouter stagiaire").Range("H10").Select
End Sub
Dernière édition: