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.

188devoir-tle.xlsm (28.80 Ko)

Bonjour et bienvenue sur le forum

En retour : j'ai simplement désactivé la macro à l'ouverture qui semblait poser problème.

Bye !

149devoir-tle-v1.xlsm (32.52 Ko)

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

Slt.

En effet, quand la boîte de dialogue d'activation des macros s'affiche comme une fenêtre, alors dans ce cas le ruban est accessible. Mais quand elle s'affiche en dessous du ruban, alors dans ce cas, le ruban n'est plus accessible.

cas ruban accessible cas ruban inacessible

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.

Rechercher des sujets similaires à "boucle while loop"