Eccomi di ritorno!
ci ho messo un po' ad elaborare questo file, ma dopo l'incitamento di Anthony non potevo tirarmi indietro.
Il lavoro è quasi terminato ed è comunque già stato sperimentato con successo durante alcune partite.
Ho trovato alcuni ostacoli, tra cui il fatto di riconoscere i nomi dei brani, ora li ho scritti tutti senza spazi e così funziona.
A meno che abbiate anche voi un figlio che gioca ad hockey dubito che vi possano servire tutte le funzioni che vi sono contenute, ma se qualcuno dovesse volere suonare
musica da excel vi può trovare vari spunti.
In particolare allego qui sotto una serie di codici che permettono di lanciare la
musica contenuta nel foglio di lavoro "playlistPausa"; alla fine di ogni brano sfuma e passa automaticamente al prossimo. Giunto all'ultimo riprende dall'inizio.
Premendo una seconda volta il toggleButton la
musica sfuma e si spegne.
Per funzionare necessita due lettori WindowsMediaPlayer sul foglio "menu" che si chiamano audio1 e audio2.
Inoltre i singoli brani devono essere inizializzati (per il codice elencato basta che in colonna G della playlist vi sia il tempo della fine del brano in secondi)
- Codice: Seleziona tutto
Dim QBrani
Option Explicit
Private Sub ToggleButton3_Click()
If ToggleButton3.Value = True Then
QBrani = Worksheets("playlistPausa").Cells(Rows.Count, "C").End(xlUp).Row - 1
Call riprod2("P", "playlistPausa", QBrani)
Else
Call chiudi2
End If
End Sub
- Codice: Seleziona tutto
Dim QBrani
Sub riprod2(ColonnaRiprod, QualePlaylist, QuantiBrani) 'tasto pausa: lancia ciclo continuo di musica
abbassato1 = 0
abbassato2 = 0
Worksheets("menu").Range(ColonnaRiprod & 4) = 1
riprendi:
If Worksheets("menu").Range(ColonnaRiprod & 4) = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
Exit Sub
End If
lettore = Worksheets("menu").Range(ColonnaRiprod & 3) 'legge quale lettore deve partire
Brano = Worksheets("menu").Range(ColonnaRiprod & 2) + 1 'correzione solo per via della riga di titolo nella playlist
vol = Worksheets(QualePlaylist).Cells(Brano, 8)
Iniz = Worksheets(QualePlaylist).Cells(Brano, 4)
fine = Worksheets(QualePlaylist).Cells(Brano, 7)
Perc = ThisWorkbook.Path & "\" & Worksheets(QualePlaylist).Cells(Brano, 2) & "\" 'percorso del file"
FileN = Perc & Worksheets(QualePlaylist).Cells(Brano, 3) 'nome del file
If lettore = 1 Then 'sarebbe tutto più semplice se si potesse impostare audio1 come variabile!!!
Foglio1.audio1.URL = FileN
Foglio1.audio1.settings.volume = vol
Foglio1.audio1.Controls.currentPosition = Iniz
Foglio1.audio1.Controls.Play
i = 0.5 'se il lettore1 è subentrato ora, abbassa il volume di 2
Do While i > -0.1
OraAttuale = Timer
Do While Timer < OraAttuale + 1
DoEvents
Loop
Foglio1.audio2.settings.volume = abbassato2 * i
i = i - 0.1
Loop
Foglio1.audio2.Controls.stop 'ferma del tutto il lettore 2
OraAttuale = Timer
Do While Timer < OraAttuale + 60 'se questo brano è passato per almeno 1 min predispone per nuovo brano se interrotto riprenderà con lo stesso brano
If Worksheets("menu").Range(ColonnaRiprod & 4) = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
Exit Sub
End If
DoEvents
Loop
nuovoBrano = (Brano - 1) Mod QuantiBrani + 1 'ricomincia da 1 dopo 60
Worksheets("menu").Range(ColonnaRiprod & 3) = 2 'prepara il lettore2 e memorizza volume attuale
ActiveWorkbook.Save
Worksheets("menu").Range(ColonnaRiprod & 2) = nuovoBrano
OraAttuale = Timer 'se il brano si avvicina alla fine (1 min tolto per il passaggio precedente) inizia a sfumare
Do While Timer < OraAttuale - 60 + fine - 20 - Iniz
DoEvents
Loop
i = 0.9 'sfuma da volume pieno a metà
Do While i > 0.6
OraAttuale = Timer
Do While Timer < OraAttuale + 1
DoEvents
Loop
Foglio1.audio1.settings.volume = vol * i
i = i - 0.1
Loop
abbassato1 = Foglio1.audio1.settings.volume
GoTo riprendi 'lancia il lettore2
End If
If lettore = 2 Then
Foglio1.audio2.URL = FileN
Foglio1.audio2.settings.volume = vol
Foglio1.audio2.Controls.currentPosition = Iniz
Foglio1.audio2.Controls.Play
i = 0.5 'se il lettore1 è subentrato ora, abbassa il volume di 2
Do While i > -0.1
OraAttuale = Timer
Do While Timer < OraAttuale + 1
DoEvents
Loop
Foglio1.audio1.settings.volume = abbassato1 * i
i = i - 0.1
Loop
Foglio1.audio1.Controls.stop 'ferma del tutto il lettore 1
OraAttuale = Timer
Do While Timer < OraAttuale + 60 'se questo brano è passato per almeno 1 min predispone per nuovo brano se interrotto riprenderà con lo stesso brano
If Worksheets("menu").Range(ColonnaRiprod & 4) = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
Exit Sub
End If
DoEvents
Loop
nuovoBrano = (Brano - 1) Mod QuantiBrani + 1 'ricomincia da 1 dopo 60
Worksheets("menu").Range(ColonnaRiprod & 3) = 1 'prepara il lettore1 e memorizza volume attuale
ActiveWorkbook.Save
Worksheets("menu").Range(ColonnaRiprod & 2) = nuovoBrano
OraAttuale = Timer 'se il brano si avvicina alla fine (1 min tolto per il passaggio precedente) inizia a sfumare
Do While Timer < OraAttuale - 60 + fine - 20 - Iniz
DoEvents
Loop
i = 0.9 'sfuma da volume pieno a metà
Do While i > 0.6
OraAttuale = Timer
Do While Timer < OraAttuale + 1
DoEvents
Loop
Foglio1.audio2.settings.volume = vol * i
i = i - 0.1
Loop
abbassato2 = Foglio1.audio2.settings.volume
GoTo riprendi 'lancia il lettore1
End If
End Sub
Sub chiudi2() 'seconda pressione dei toggle buttons: sfuma entrambi i lettori
volumeAtt1 = Foglio1.audio1.settings.volume
volumeAtt2 = Foglio1.audio2.settings.volume
Worksheets("menu").Range("P4") = 0 'impedisce che il ciclo riprodPausa riprenda
Worksheets("menu").Range("R4") = 0 'impedisce che il ciclo riprodPausa riprenda
i = 0.9
Do While i > -0.1
OraAttuale = Timer
Do While Timer < OraAttuale + 0.3
DoEvents
Loop
Foglio1.audio1.settings.volume = volumeAtt1 * i
Foglio1.audio2.settings.volume = volumeAtt2 * i
i = i - 0.1
Loop
Foglio1.audio1.Controls.stop
Foglio1.audio2.Controls.stop
End Sub
sto cercando di attivare un link con tutta la cartella zippata, per chi lo volesse provare, ma sto avendo un po' di difficoltà, se non funziona cerco un'alternativa e ve lo posto successivamente.
)
