XL 2019 Petit souci avec une alerte sonore et alerte msgbox

Optimal

XLDnaute Junior
Bonjour,

Voila j'ai un petit souci avec une alerte que j'ai mis pour être informé du changement de valeur dans une cellule.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("E12") >= 3.8 Then Beep

If Range("E12") >= 3.8 Then
MsgBox "Attention valeur atteinte"
End If
End Sub


Donc jusque la ça fonctionne très bien.
Seulement si j'ai des manipulations à faire dans la feuille, a chaque déplacement que j'effectue, l'alerte sonore retentit et le msgbox réapparait. C'est un peu ennuyant.
Y'a t'il un moyen de coder ça différemment pour que lorsque je valide OK sur le msgbox la macro s’arrête temporairement et qu'elle se réactive à la demande seulement ?

Merci d'avance

Gilles
 

Optimal

XLDnaute Junior
Je vous explique.

Le problème est que lorsque j'ai les fenêtres d'alerte, une fois que j'ai lu le message et cliqué sur le bouton OK ensuite les changements dans les cellules ne font plus réagir l'alerte. Il me faut donc cliquer sur le bouton de reinit et la ça refonctionne. Le problème est que si j'oublie d'appuyer je ne reçois plus d'alerte.
 

Optimal

XLDnaute Junior
Bonjour

Alors voila j'ai pu effectuer des tests en situation réelle et la déception ça ne fonctionne pas.
Le problème c'est que la prise en compte se fait après validation d'une cellule ou déplacement dans la feuille. Lorsque j'ai fait mes tests et n'ayant pas de mouvement en direct, j'ai saisi des données manuellement et la tout est ok et ça fonctionne nickel. Dans mon cas précis je n'ai pas de validation puisque les cellules se modifient seule par lien DDE et donc il n'y a aucune validation qui se fasse. y'a t'il moyen de tester le moindre mouvement dans une cellule ?
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Alors peut-être qu'en utilisant l'évènement 'Worksheet_Calculate' vous arriveriez à quelque chose. Faire attention toutefois à ne pas entraîner des rappels en boucle de l'évènement en modifiant des valeurs calculées dans votre code

cordialement
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,
J'ai essayé le Worksheet_Calculate et résultat j'ai tout bloqué :) :) :)
D'où l'avertissement :
attention toutefois à ne pas entraîner des rappels en boucle de l'évènement en modifiant des valeurs calculées dans votre code

Si vous avez des cellules (ou valeur de noms) à modifier dans votre code (Worksheet_Calculate) utilisez une forme de :

VB:
' 1 --- Empêcher le rappel de l'évènement
Application.Calculation = xlCalculationManual
  
   ' 2 ---- modification(s) qui entraîne(nt) un recalcul
   Cells(2,1) = "toto"
  
' 3 ---- réinitialiser le calcul automatique
Application.Calculation = xlCalculationAutomatic
 

Optimal

XLDnaute Junior
Je dois mettre ça ou dans mon code ?



VB:
Option Explicit

Dim arretHausse(1 To 10000) As Boolean, arretBaisse(1 To 10000) As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Scanner
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   Scanner
End Sub

Sub Scanner()
Dim derlig&, t, i&, s$
   derlig = Application.IfError(Application.Match(String(255, "z"), Columns(2), 1), 0)
   If derlig <= 1 Then Exit Sub
   t = Range("a1:p1").Resize(derlig)
   For i = 2 To UBound(t)
      If IsNumeric(t(i, 7)) Then
         If t(i, 15) <> "" And t(i, 7) >= t(i, 15) And (Not arretHausse(i)) Then
            s = t(i, 2) & vbLf & " a atteint ou dépassée" & vbLf & _
            "la valeur à la hausse : " & Format(t(i, 15), "#,##0.0000")
            MsgBox s, vbExclamation + vbOKOnly
            arretHausse(i) = True
         End If
         If t(i, 16) <> "" And t(i, 7) <= t(i, 16) And (Not arretBaisse(i)) Then
            s = t(i, 2) & vbLf & " a atteint ou est passée sous" & vbLf & _
            "la valeur à la baisse : " & Format(t(i, 16), "#,##0.0000")
            MsgBox s, vbExclamation + vbOKOnly
            arretBaisse(i) = True
         End If
      End If
   Next i
End Sub

Sub ReInitInfo()
Dim i&
   For i = 1 To UBound(arretHausse): arretHausse(i) = False: Next
   For i = 1 To UBound(arretBaisse): arretBaisse(i) = False: Next
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Changement de philosophie : on utilise un OnTime qui lance l'analyse ( procédure Scanner ) à intervalle régulier
  • l'intervalle en seconde est défini par une constante Intervalle dans Module1
  • le nom de la feuille à analyser est défini par la constante LaFeuille dans Module1
  • la fonction et le fonctionnement du bouton n'ont pas été modifiés
Un petit code a été placé dans le module de ThisWorkbook pour lancer le processus du OnTime à l'ouverture du classeur et l'arrêter à la fermeture du classeur :
VB:
Private Sub Workbook_Open()
   Sheets("Feuil1").Activate
   Scanner
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   On Error Resume Next
   Application.OnTime ProchaineAnalyse, "Scanner", , False
   On Error Resume Next
End Sub

Le code dans le module de Feuil1 a été supprimé et remplacé par celui de module1 :
VB:
Option Explicit

Public Const Intervalle = 10  'intervalle entre deux analyses (en seconde)
Const LaFeuille = "Feuil1"
Public ProchaineAnalyse
Dim arretHausse(1 To 10000) As Boolean
Dim arretBaisse(1 To 10000) As Boolean

Sub Scanner()
Dim derlig&, t, i&, s$
   On Error Resume Next
   Application.OnTime ProchaineAnalyse, "Scanner", , False
   On Error Resume Next
   derlig = Application.IfError(Application.Match(String(255, "z"), Sheets(LaFeuille).Columns(2), 1), 0)
   If derlig <= 1 Then Exit Sub
   t = Sheets(LaFeuille).Range("a1:o1").Resize(derlig)
   For i = 2 To UBound(t)
      If IsNumeric(t(i, 6)) Then
         If t(i, 14) <> "" And t(i, 6) >= t(i, 14) And (Not arretHausse(i)) Then
            s = t(i, 2) & vbLf & "a atteint ou a dépassé" & vbLf & _
            "le seuil à la hausse = " & Format(t(i, 14), "#,##0.0000")
            MsgBox s, vbExclamation + vbOKOnly
            arretHausse(i) = True
            Sheets(LaFeuille).Shapes("BoutonAlerte").Fill.ForeColor.RGB = RGB(255, 192, 0)
         End If
         If t(i, 15) <> "" And t(i, 6) <= t(i, 15) And (Not arretBaisse(i)) Then
            s = t(i, 2) & vbLf & "a atteint ou est passée sous" & vbLf & _
            "le seuil à la baisse = " & Format(t(i, 15), "#,##0.0000")
            MsgBox s, vbExclamation + vbOKOnly
            arretBaisse(i) = True
            Sheets(LaFeuille).Shapes("BoutonAlerte").Fill.ForeColor.RGB = RGB(255, 192, 0)
         End If
      End If
   Next i
   ProchaineAnalyse = Now() + Intervalle / (24# * 60 * 60)
   Application.OnTime ProchaineAnalyse, "Scanner", , True
End Sub

Sub ReInitInfo()
Dim i&
   For i = 1 To UBound(arretHausse): arretHausse(i) = False: Next
   For i = 1 To UBound(arretBaisse): arretBaisse(i) = False: Next
   Sheets(LaFeuille).Shapes("BoutonAlerte").Fill.ForeColor.RGB = RGB(146, 208, 80)
End Sub

Edit : version v4b qui annule le timer à la fermeture du fichier.
 

Pièces jointes

  • Optimal- Alerte unique- v4b.xlsm
    28 KB · Affichages: 20
Dernière édition:

Optimal

XLDnaute Junior
@mapomme

Merci pour cette nouvelle mouture.

Je n'ai pas eu trop le temps de tester ça avant clôture de la bourse. Mais les premiers essais ont l'air concluant. Par contre ( à confirmer tout de même ) si ma page excel ne reste pas en avant plan j'ai l'impression que ça ne fonctionne plus. Mais bon je confirmerai demain.

Gilles
 
Dernière édition:

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal