Boucle Do While Loop
Bonsoir à tous,
J'ai créé des macros permettant de corriger le devoir des élèves. Le fichier à un module de code contenant des procédures. "ThisWorkbook" contient aussi une macro permettant d'initialiser un chrono et de masquer la correction.
A l'ouverture du fichier, le chrono est lancé et la feuille de calcul est accessible, mais le ruban reste inaccessible. Il n'est pas grisé non plus.
ThisWorkbook
Dim duree, TempsFin, TempsDebut
Public CorBut As Boolean
Private Sub Workbook_Open()
Dim Obj As OLEObject 'declaration de l'objet OLE control
Set Obj = Feuil1.OLEObjects("Label1") ' affectation de la variable objet Obj au controle Label1
'Initialisation de la variable Obj
With Obj
.Object.BackStyle = 0
.ShapeRange.Fill.Transparency = 1#
End With
Masquer
CorBut = False
duree = 0
TempsDebut = Timer / 60
Do While duree < 30
TempsFin = Timer / 60
duree = TempsFin - TempsDebut
Obj.Object.Caption = duree
'Debug.Print Round(duree, 2) & " min"
If CorBut = True Then Exit Do
DoEvents
Loop
Set Obj = Nothing
If duree > 30 Then Module1.Correction
End Sub
Sub Masquer()
'
Range("H2:J19").Select
Selection.EntireColumn.Hidden = True
Sheets("Sujet").Activate
End Sub
Module1
'Déclaration des variables
Dim Li, Ci As Byte
Dim pts As Single
Dim bordRight, bordLeft, bordBottom, bordTop, bordInHor, bordInVer As Integer
Sub Correction()
'Procedure principale
pts = 20 'initialisation de la note
'correction
CorrectionDonnées
CorrectionFormat
If pts < 0 Then
pts = 0
End If
Afficher ' procedure d'affichage de la correction
ThisWorkbook.CorBut = True ' mettre corbut à true pour stopper la boucle Do
'Affichage de la Note
MsgBox "NOTE " & pts
End Sub
Sub CorrectionDonnées()
' Procedure de correction des données
For Li = 2 To 19 Step 1
For Ci = 1 To 3 Step 1
'verification de la saisie sur 6/54
If Cells(Li, Ci) <> Cells(Li, Ci + 7) Then
pts = pts - 0.111111
End If
'verification de la police sur 1/53
If Cells(Li, Ci).Font.Name <> Cells(Li, Ci + 7).Font.Name Then
pts = pts - 0.01886
End If
'verification de la taille de police sur 1/53
If Cells(Li, Ci).Font.Size <> Cells(Li, Ci + 7).Font.Size Then
pts = pts - 0.01886
End If
'verification de la couleur de police sur 2 (penalités)
If Cells(Li, Ci).Font.Color <> Cells(Li, Ci + 7).Font.Color Then
pts = pts - 0.033334
End If
'verification du style Gras de police sur 2 (penalités)
If Cells(Li, Ci).Font.Bold <> Cells(Li, Ci + 7).Font.Bold Then
pts = pts - 0.033334
End If
Next Ci
Next Li
'verification de la couleur de police des cellules A19 et C19 sur 2
If Cells(19, 1).Font.Color <> Cells(19, 8).Font.Color Then
pts = pts - 0.9
End If
If Cells(19, 3).Font.Color <> Cells(19, 10).Font.Color Then
pts = pts - 0.9
End If
'verification du style Gras de police des cellules A1,B1,C1,A19,B19,C19 sur 2
If Cells(2, 1).Font.Bold <> Cells(2, 8).Font.Bold And _
Cells(2, 2).Font.Bold <> Cells(2, 9).Font.Bold And _
Cells(2, 3).Font.Bold <> Cells(2, 10).Font.Bold Then
pts = pts - 0.9
End If
If Cells(19, 1).Font.Bold <> Cells(19, 8).Font.Bold And _
Cells(19, 2).Font.Bold <> Cells(19, 9).Font.Bold And _
Cells(19, 3).Font.Bold <> Cells(19, 10).Font.Bold Then
pts = pts - 0.9
End If
End Sub
Sub CorrectionFormat()
' Procedure de correction du format des données et de la feuille
For Li = 2 To 19 Step 1
For Ci = 1 To 3 Step 1
' verification des bordures sur 3/54
If Cells(Li, Ci).Borders(xlEdgeRight).LineStyle <> Cells(Li, Ci + 7).Borders(xlEdgeRight).LineStyle _
And Cells(Li, Ci).Borders(xlEdgeRight).LineStyle <> Cells(Li, Ci + 7).Borders(xlEdgeRight).LineStyle _
And Cells(Li, Ci).Borders(xlEdgeRight).LineStyle <> Cells(Li, Ci + 7).Borders(xlEdgeRight).LineStyle _
And Cells(Li, Ci).Borders(xlEdgeRight).LineStyle <> Cells(Li, Ci + 7).Borders(xlEdgeRight).LineStyle Then
pts = pts - 0.055555
End If
If Cells(Li, Ci).Interior.Color <> Cells(Li, Ci + 7).Interior.Color Then
pts = pts - 0.0333334
End If
Next Ci
Next Li
'verification de la couleur de remplissage sur 2/54
If Cells(2, 1).Interior.Color <> Cells(2, 8).Interior.Color And _
Cells(2, 2).Interior.Color <> Cells(2, 9).Interior.Color And _
Cells(2, 3).Interior.Color <> Cells(2, 10).Interior.Color Then
pts = pts - 0.9
End If
If Cells(19, 1).Interior.Color <> Cells(19, 8).Interior.Color And _
Cells(19, 2).Interior.Color <> Cells(19, 9).Interior.Color And _
Cells(19, 3).Interior.Color <> Cells(19, 10).Interior.Color Then
pts = pts - 0.9
End If
'verification de la largeur de la colonne B sur 2
If Worksheets("Sujet").Columns("B").ColumnWidth <> Worksheets("Sujet").Columns("I").ColumnWidth Then
pts = pts - 2
End If
End Sub
Sub Afficher()
'
Range("H2:J19").Select
Selection.EntireColumn.Hidden = False
End Sub
Merci de me répondre.
Bonjour et bienvenue sur le forum
En retour : j'ai simplement désactivé la macro à l'ouverture qui semblait poser problème.
Bye !
Merci pour votre contribution.
Si vous désactivez la macro, le code ne s'executera plus. Or, il faut que la macro soit
activée pour que le chrono soit en marche, et la procédure de correction soit exécutée.
D'où le problème à l'ouverture.
Bonsoir à tous.
Le problème persiste toujours. le code de mon chrono est dans le module ThisWorkbook.
Je n'ai pas encore résolu le problème.
Bonjour
Je ne comprend pas , car chez moi, on voit défiler le compteur, mais le ruban reste accessible...
???
Bon courage
Bonjour,
j'ai une question : elle est où la question ?
si tu acceptes les macros, à l'ouverture suivante il ne doit plus te demander.
eric
Bonjour, à chaque ouverture, Le message d'activation s'affiche, me demandant d'activer les macros. Là n'est pas le problème, mais les manières d'activation, comme illustrées plus haut.
Quand il s'affiche sous le ruban, les onglets et commandes restent inaccessibles. (Illustration 1)
Par contre, quand il s'affiche directement comme une boite de dialogue, le ruban accessible. (Illustration 2).
C'est ce que je n'arrive pas comprendre. Y a-t-il un réglage à faire pour qu'on ait toujours comme message d'activation le cas 2 (Illustration 2)?
J'ai contourné le problème en rendant l'activation du chrono manuel (à l'aide d'un bouton de commande), en mettant le code dans du chrono dans un module. Là mon problème est résolu, mais le chrono est manuel. Ce n'est pas ce que je veux.
Mais je veux que l'activation du chrono soit lié à l'ouverture du fichier, pour qu'elle soit automatique. C'est là qu'il y a le problème de blocage du ruban.
Bonjour,
les 2 messages sont différents, ça ne dépend pas de leur emplacement.
Tu peux désactiver l'alerte sur les ActiveX dans les Options, Centre de gestion de la confidentialité. Mais je ne le conseille pas.
Tu n'as pas l'air d'avoir d'ActiveX, tes boutons sont de type Formulaire. Essaie de refaire dans un classeur tout neuf.
Ou bien mettre le document dans un emplacement approuvé, ou ajouter le bureau (de chaque utilisateur) dans cette liste. Toujours dans les Options, Centre de gestion de la confidentialité.
eric
J'ai déjà testé ce cas. Tout est parfait. Mais inconvénient: l'ordinateur reste vulnérable. Il faut que l'alerte soit activée. La remarque que j'ai faite, est que mon dépend du type de message. Je l'ai fait plusieurs fois.
En fait le code du chrono n'est lié à aucun bouton. Donc les boutons ne sont pas responsables. Au contraire, quand je lie l'activation du chrono à un bouton. Cela résout mon problème, mais à moitié car l'activation reste manuelle. Or je veux qu'elle soit automatique.
Tu es sûr de lire complètement les réponses ?
Je t'ai proposé plusieurs pistes, tu ne réponds qu'à une seule.