Moderatori: Anthony47, Flash30005
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
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
If lettore = 1 then Set myLett=Foglio1.audio1 else Set myLett=Foglio1.audio2
myLett.URL=FileN
'etc etc
ecco! era così semplice! io ho provato cercando di memorizzare come variabile solo il numero, invece si può lavorare sul blocco.Anthony47 ha scritto:If lettore = 1 then Set myLett=Foglio1.audio1 else Set myLett=Foglio1.audio2
E chi l'ha detto che era sempliceecco! era così semplice!
trovo una lista interminabile di cui solo i prime 7 hanno una spunta, ma non vedo differenze tra le versioni in cui poi i pulsanti funzionano e quelle in cui non lo fanno.Anthony47 ha scritto:Menu / Strumenti /Riferimenti, se hai dei componenti dichiarati "MANCANTE"
Torna a Applicazioni Office Windows
Macro per aprire file salvato su sharepoint Onedrive Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 0 |
Come impostare il formato data predefinito in excel? Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 5 |
Come interrompere macro sndPlaySound Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 16 ospiti