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

[GEORGE1]

Καλημέρα στους φίλους και φίλες,

Έχω φτιάξει ένα αρχειάκι με τις τέσσερες πράξεις της απλής αριθμητικής για την εγγονή μου, το οποίο ανάλογα με την απάντηση που δίνει της εμφανίζει «ΣΩΣΤΟ» ή «ΛΑΘΟΣ».
Μέχρι εδώ όλα καλά ο προβληματισμός μου είναι αν μετά από κάθε απάντηση μπορεί να προστεθεί ένα ηχητικό επιβράβευσης αν η απάντηση είναι σωστή ή «αποδοκιμασίας» αν είναι λάθος.

Ευχαριστώ για τον χρόνο σας,

Γιώργος

[GEORGE1]

Το παραπάνω αρχείο είναι σε είναι σε excel 2007 αλλά μόλις τώρα πληροφορήθηκα ότι στον υπολογιστή της έχει excel 2003 …

Ευχαριστώ και πάλι για τον χρόνο σας,

Γιώργος

[Tasos]

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

Δοκίμασε τον παρακάτω κώδικα στην κλάση "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

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

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

[GEORGE1]

Τάσο σε ευχαριστώ, θα το δοκιμάσω και τα λέμε.