Forum - Γενικά Πρόσθεση ηχητικού μηνύματος

Καλησπέρα Γιώργο!

Δοκίμασε τον παρακάτω κώδικα στην κλάση "ThisWorkbook" του παραδείγματος που ανέβασες:

Κώδικας:

Option Explicit

Private Const SND_ASYNC = 1&

Private Declare Function PlaySound Lib "winmm.dll" _

                                   Alias "sndPlaySoundA" ( _

                                   ByVal lpszSoundName As String, _

                                   ByVal uFlags As Long) As Long
 

Private Sub PlaySoundFile(SoundPath As String)

    If Dir(SoundPath, vbNormal) <> "" Then

        PlaySound SoundPath, SND_ASYNC

    End If

End Sub
 

Private Function CheckValidity(rng As Range) As Boolean

    Dim ret As Double, i As Integer, EvalString As String

    If WorksheetFunction.CountA(rng) = rng.Count Then

        For i = 1 To rng.Count - 2

            If Trim(rng(i).Value) <> vbNullString Then

                EvalString = EvalString & Trim(Replace(rng(i).Value, "'", vbNullString))

            Else

               'PlaySoundFile "C:\Ο Φάκελος σου\Λάθος.wav

                PlaySoundFile Environ("SystemRoot") & "\Media\" & "chord.wav"

                MsgBox "Αφαίρεσε τα διαστήματα από το κελί " & rng(i).Address(False, False), vbInformation

                Exit Function

            End If

        Next

        ret = Evaluate(EvalString)

        If rng(i + 1).Value = ret Then

            'PlaySoundFile "C:\Ο Φάκελος σου\Σωστό.wav"

            PlaySoundFile Environ("SystemRoot") & "\Media\" & "tada.wav"

        Else

            'PlaySoundFile "C:\Ο Φάκελος σου\Λάθος.wav"

            PlaySoundFile Environ("SystemRoot") & "\Media\" & "chord.wav"

        End If

    End If

End Function
 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Select Case Sh.CodeName

        Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6"

            If Target.Row < 3 Then Exit Sub

            If Not Intersect(Target, Range("A:E")) Is Nothing Then

                CheckValidity Range(Cells(Target.Row, Range("A:E").Column), _

                                    Cells(Target.Row, Range("A:E").Column + _

                                                      Range("A:E").Columns.Count - 1))

            ElseIf Not Intersect(Target, Range("H:L")) Is Nothing Then

                CheckValidity Range(Cells(Target.Row, Range("H:L").Column), _

                                    Cells(Target.Row, Range("H:L").Column + _

                                                      Range("H:L").Columns.Count - 1))

            End If

    End Select

End Sub

Καλή συνέχεια!

ΥΓ. Ελπίζω να υπάρχουν αρκετοί παππούδες σαν εσένα στην Ελλάδα μας μπας και δούμε τουλάχιστον από τις νεότερες γενεές μια άσπρη μέρα!:003: