Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Ripetere il suono finchè è presente il valore 1

Ultimo Aggiornamento: 07/05/2018 09:57
Post: 33
Registrato il: 08/06/2010
Città: MILANO
Età: 28
Utente Junior
excel 2007
OFFLINE
07/05/2018 09:57

Salve a tutti. Chiedo a voi un aiuto. Vorrei che il suono si ripeta con intervalli di 5 sec finchè nelle celle è presente valore 1. Grazie mille a chi mi può aiutare.
Questo è il codice che uso:

'=============>>
Option Explicit

'------------------->>
Private Declare Function PlaySound _
Lib "winmm.dll" _
Alias "PlaySoundA" _
(ByVal lpszName As String, _
ByVal hModule As Long, _
ByVal dwFlags As Long) As Long

'------------------->>
Public Sub Suono(sPath)
Const SND_ASYNC = &H1 ' Suona in modo asincrono
Const SND_FILENAME = &H20000 ' Nome e' il nome di un file

Call PlaySound(sPath, _
ByVal 0&, _
SND_FILENAME Or SND_ASYNC)
End Sub
'<<=============

'=============>>
Private Sub Worksheet_Calculate()
Dim Rng As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim rCell As Range
Dim myWav As String
Dim ok As Boolean

Const sStr As String = "1"
Const sPercorso As String = _
"C:\WINDOWS\Media\"
Const sWav As String = "Windows XP - Ripristino.WAV"
Const sWav2 As String = "alarm.WAV"

Set Rng = Range("f2:f18")
Set Rng2 = Range("g2:g18")

For Each rCell In Rng.Cells
' se c'è una variazione sulla colonna 'E' allora elabora la variazione
'If Target.Column = 5 Then
' se il valore della colonna 'AL ' è variato
If Not IsEmpty(rCell.Value) Then
If Not IsError(rCell.Value) Then
If rCell <> Rng2.Cells(rCell.Row - 1, 1) Then
' copia il nuovo valore nel vecchio
Rng2.Cells(rCell.Row - 1, 1) = rCell

' se il nuovo è 1 allora suona
If rCell = 1 Then
Call Suono(sPercorso & sWav2)
End If
End If

End If

End If


Next rCell

' If Not Rng2 Is Nothing Then
' For Each rCell In Rng2.Cells
' With rCell
' MsgBox (.Row)
' MsgBox (.Column)

' If Not IsEmpty(.Value) Then
' If Not IsError(.Value) Then
' If StrComp(rCell.Value, sStr, _
' vbTextCompare) = 0 Then
' ok = True
' Exit For
' Else
' ok = False
' End If
' End If
' End If
' End With
' Next rCell
'
' End If
End Sub
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 00:45. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com