Εμφάνιση ενός μόνο μηνύματος
  #3  
Παλιά 10-10-13, 16:27
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.011
Προεπιλογή

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

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

ΥΓ. Ελπίζω να υπάρχουν αρκετοί παππούδες σαν εσένα στην Ελλάδα μας μπας και δούμε τουλάχιστον από τις νεότερες γενεές μια άσπρη μέρα!
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση