AGGIUNGERE MUSICA ED EFFETTI SONORI

Hai un problema con Excel?

Nuova discussione

AGGIUNGERE MUSICA ED EFFETTI SONORI
di FA-BA (utente non iscritto) data: 03/09/2016 11:51:40
Salve vorrei aggiungere al mio file Excel nominato "ULTIMO.LA BATTAGLIA DEI POTENTI V 33.
vorrei inserire:
1)1.mp3 all'avvio ... per sempre in ripetizione (Loop).
2)1.wav quando cella F24=Eliminerà DELLA SCHEDA ->GIOCO.

PER IL MOMENTO TUTTO QUI.

Sub CicloConMatriceValori()
If Sheets("GIOCO").Range("AB47") = 1 Then MsgBox "Scelte errate!": Exit Sub
    Const sIntRngOrig As String = "G6:G12"
    Const sIntRngDest As String = "C6:C12"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim IntRngOrig As Range
    Dim IntRngDest As Range
    Dim arrValori() As Variant
    Dim i As Integer, i2 As Integer
    Dim IndiceRiferimento As Integer
    Dim Valore1, Valore2, Valore3, Valore4, Valore5, Valore6

    Set Wb = ThisWorkbook

   '<--- disabilito lo schermo, gli eventi e imposto il calcolo in manuale --->
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
  
     With Wb
         '<--- memorizzo i valori presenti in G6:G12 in una matrice --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngOrig = .Range(sIntRngOrig)
                 With IntRngOrig
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     ReDim Preserve arrValori(1 To i2)
                     arrValori(i2) = .Cells(i, 1).Value
                   Next i
                 End With
             End If
           End With
         Next Ws

         '<--- riporto i valori memorizzati nella precedente matrice nelle celle C6:C12 --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngDest = .Range(sIntRngDest)
                 With IntRngDest
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     .Cells(i, 1).Value = arrValori(i2)
                   Next i
                 End With
             End If
           End With
         Next Ws

        '<--- fine trasferimento in matrice / inizio conteggio macro in (I.A) CELLA AB49 --->
         With .Sheets("(I.A)")
          If .Range("AE49") = 7 Then

           .Range("AE49") = 1
            .Range("W48:AB53") = Empty
         Else
           .Range("AE49") = .Range("AE49") + 1
         End If

           IndiceRiferimento = .Range("AE49").Value '<--- 1,2,3,4,5,6,7
           Valore1 = Wb.Sheets("GIOCO").Range("H21").Value
           Valore2 = .Range("Q3").Value
           Valore3 = Wb.Sheets("GIOCO").Range("H20").Value
           Valore4 = .Range("Q2").Value
           Valore5 = Wb.Sheets("GIOCO").Range("H19").Value
           Valore6 = .Range("Q1").Value
           Select Case IndiceRiferimento
           Case 1
             .Range("V48") = Valore1
             .Range("V49") = Valore2
             .Range("V50") = Valore3
             .Range("V51") = Valore4
             .Range("V52") = Valore5
             .Range("V53") = Valore6
           Case 2
             .Range("W48") = Valore1
             .Range("W49") = Valore2
             .Range("W50") = Valore3
             .Range("W51") = Valore4
             .Range("W52") = Valore5
             .Range("W53") = Valore6
           Case 3
             .Range("X48") = Valore1
             .Range("X49") = Valore2
             .Range("X50") = Valore3
             .Range("X51") = Valore4
             .Range("X52") = Valore5
             .Range("X53") = Valore6
           Case 4
             .Range("Y48") = Valore1
             .Range("Y49") = Valore2
             .Range("Y50") = Valore3
             .Range("Y51") = Valore4
             .Range("Y52") = Valore5
             .Range("Y53") = Valore6
           Case 5
             .Range("Z48") = Valore1
             .Range("Z49") = Valore2
             .Range("Z50") = Valore3
             .Range("Z51") = Valore4
             .Range("Z52") = Valore5
             .Range("Z53") = Valore6
           Case 6
             .Range("AA48") = Valore1
             .Range("AA49") = Valore2
             .Range("AA50") = Valore3
             .Range("AA51") = Valore4
             .Range("AA52") = Valore5
             .Range("AA53") = Valore6
           Case 7
             .Range("AB48") = Valore1
             .Range("AB49") = Valore2
             .Range("AB50") = Valore3
             .Range("AB51") = Valore4
             .Range("AB52") = Valore5
             .Range("AB53") = Valore6
           End Select
         End With
    
         MsgBox "Fatto!"
     End With

 '<--- riattivo lo schermo, gli eventi e imposto nuovamente il calcolo in automatico --->
   With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
   End With
 End Sub

di FA-BA data: 03/09/2016 14:05:12
...HELP!

di FA-BA data: 03/09/2016 14:36:47
HO PROVATO QUESTA MA NON FUNZIONA..... come posso fare

Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

   Sub PlaySound()
       If Application.CanPlaySounds Then
           'Substitute the path and filename of the sound you want to play
           Call sndPlaySound32("Musica de Suspense  Terror -  Requiem For Dream.mp3", 0)
       End If

di patel data: 03/09/2016 15:52:21
per forza non funziona, oltre tutto c'è anche scritto 'Substitute the path and filename of the sound you want to play
il path è il percorso, non basta il nome del file, devi dirgli anche dove si trova
di FA-BA data: 04/09/2016 13:00:29
NON C'è MODO DI FARGLI LEGGERE LA CARTELLA IN USO????

comunque CIò PROVATO E RIPROVATO MI DICE DOPO END SUB SONO AMMESSI SOLO COMMENTI !!

Non riesco ad eseguire mp3 in avvio poi vorrei degli effetti sonori in base hai valori cella come detto inizialmente ,.. potete aiutarmi?

Grazie mille!
di patel data: 04/09/2016 14:42:35
impossibile aiutarti senza vedere cosa fai, ti limiti a dire che non funziona
di FA-BA data: 04/09/2016 14:47:11
Perché NON So COSA FARE NEL VERO SENSO DELLA PAROLA, so cosa voglio ma non come fare!
Se sapete come fare , vi ringrazio.

Ricompilo la domanda Vorrei inserire:
1.mp3 all'avvio ... per sempre in ripetizione (Loop).
E.wav se F24=Eliminerà DELLA SCHEDA ->GIOCO.
M.wav se F24=Morirà DELLA SCHEDA ->GIOCO.
V.wav se F24=Vincerà DELLA SCHEDA ->GIOCO.
S.wav se F24=Sopravvivrà DELLA SCHEDA ->GIOCO.
P.wav se F24=Pareggerà DELLA SCHEDA ->GIOCO.
di patel data: 04/09/2016 15:49:53
ti ho detto che devi inserire il percorso completo del file mp3, tu hai detto che non funziona ma non mi hai fatto vedere cosa hai modificato e come

di FA-BA data: 04/09/2016 16:49:22
HO PROVATO COSì
MA NULLA

Sub CicloConMatriceValori()
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
       If Application.CanPlaySounds Then
           'Substitute the path and filename of the sound you want to play
           Call sndPlaySound32("F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3", 0)
If Sheets("GIOCO").Range("AB47") = 1 Then MsgBox "Scelte errate!": Exit Sub
    Const sIntRngOrig As String = "G6:G12"
    Const sIntRngDest As String = "C6:C12"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim IntRngOrig As Range
    Dim IntRngDest As Range
    Dim arrValori() As Variant
    Dim i As Integer, i2 As Integer
    Dim IndiceRiferimento As Integer
    Dim Valore1, Valore2, Valore3, Valore4, Valore5, Valore6

    Set Wb = ThisWorkbook

   '<--- disabilito lo schermo, gli eventi e imposto il calcolo in manuale --->
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
  
     With Wb
         '<--- memorizzo i valori presenti in G6:G12 in una matrice --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngOrig = .Range(sIntRngOrig)
                 With IntRngOrig
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     ReDim Preserve arrValori(1 To i2)
                     arrValori(i2) = .Cells(i, 1).Value
                   Next i
                 End With
             End If
           End With
         Next Ws

         '<--- riporto i valori memorizzati nella precedente matrice nelle celle C6:C12 --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngDest = .Range(sIntRngDest)
                 With IntRngDest
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     .Cells(i, 1).Value = arrValori(i2)
                   Next i
                 End With
             End If
           End With
         Next Ws

        '<--- fine trasferimento in matrice / inizio conteggio macro in (I.A) CELLA AB49 --->
         With .Sheets("(I.A)")
          If .Range("AE49") = 7 Then

           .Range("AE49") = 1
            .Range("W48:AB53") = Empty
         Else
           .Range("AE49") = .Range("AE49") + 1
         End If

           IndiceRiferimento = .Range("AE49").Value '<--- 1,2,3,4,5,6,7
           Valore1 = Wb.Sheets("GIOCO").Range("H21").Value
           Valore2 = .Range("Q3").Value
           Valore3 = Wb.Sheets("GIOCO").Range("H20").Value
           Valore4 = .Range("Q2").Value
           Valore5 = Wb.Sheets("GIOCO").Range("H19").Value
           Valore6 = .Range("Q1").Value
           Select Case IndiceRiferimento
           Case 1
             .Range("V48") = Valore1
             .Range("V49") = Valore2
             .Range("V50") = Valore3
             .Range("V51") = Valore4
             .Range("V52") = Valore5
             .Range("V53") = Valore6
           Case 2
             .Range("W48") = Valore1
             .Range("W49") = Valore2
             .Range("W50") = Valore3
             .Range("W51") = Valore4
             .Range("W52") = Valore5
             .Range("W53") = Valore6
           Case 3
             .Range("X48") = Valore1
             .Range("X49") = Valore2
             .Range("X50") = Valore3
             .Range("X51") = Valore4
             .Range("X52") = Valore5
             .Range("X53") = Valore6
           Case 4
             .Range("Y48") = Valore1
             .Range("Y49") = Valore2
             .Range("Y50") = Valore3
             .Range("Y51") = Valore4
             .Range("Y52") = Valore5
             .Range("Y53") = Valore6
           Case 5
             .Range("Z48") = Valore1
             .Range("Z49") = Valore2
             .Range("Z50") = Valore3
             .Range("Z51") = Valore4
             .Range("Z52") = Valore5
             .Range("Z53") = Valore6
           Case 6
             .Range("AA48") = Valore1
             .Range("AA49") = Valore2
             .Range("AA50") = Valore3
             .Range("AA51") = Valore4
             .Range("AA52") = Valore5
             .Range("AA53") = Valore6
           Case 7
             .Range("AB48") = Valore1
             .Range("AB49") = Valore2
             .Range("AB50") = Valore3
             .Range("AB51") = Valore4
             .Range("AB52") = Valore5
             .Range("AB53") = Valore6
           End Select
         End With
    
         MsgBox "Fatto!"
     End With

 '<--- riattivo lo schermo, gli eventi e imposto nuovamente il calcolo in automatico --->
   With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
   End With
 End Sub

di patel data: 04/09/2016 18:12:23
il declare deve stare prima della sub

Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub CicloConMatriceValori()
       If Application.CanPlaySounds Then
           Call sndPlaySound32("F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3", 0)
........

di FA-BA data: 04/09/2016 18:36:06
Non mi da errori ma nemmeno funziona non sento nulla!

Option Explicit
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub CicloConMatriceValori()
       If Application.CanPlaySounds Then
           Call sndPlaySound32("F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3", 0)

If Sheets("GIOCO").Range("AB47") = 1 Then MsgBox "Scelte errate!": Exit Sub
    Const sIntRngOrig As String = "G6:G12"
    Const sIntRngDest As String = "C6:C12"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim IntRngOrig As Range
    Dim IntRngDest As Range
    Dim arrValori() As Variant
    Dim i As Integer, i2 As Integer
    Dim IndiceRiferimento As Integer
    Dim Valore1, Valore2, Valore3, Valore4, Valore5, Valore6
    Set Wb = ThisWorkbook
'<--- disabilito lo schermo, gli eventi e imposto il calcolo in manuale --->
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
  With Wb
         '<--- memorizzo i valori presenti in G6:G12 in una matrice --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngOrig = .Range(sIntRngOrig)
                 With IntRngOrig
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     ReDim Preserve arrValori(1 To i2)
                     arrValori(i2) = .Cells(i, 1).Value
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- riporto i valori memorizzati nella precedente matrice nelle celle C6:C12 --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngDest = .Range(sIntRngDest)
                 With IntRngDest
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     .Cells(i, 1).Value = arrValori(i2)
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- fine trasferimento in matrice / inizio conteggio macro in (I.A) CELLA AB49 --->
         With .Sheets("(I.A)")
          If .Range("AE49") = 7 Then
.Range("AE49") = 1
            .Range("W48:AB53") = Empty
         Else
           .Range("AE49") = .Range("AE49") + 1
         End If
IndiceRiferimento = .Range("AE49").Value '<--- 1,2,3,4,5,6,7
           Valore1 = Wb.Sheets("GIOCO").Range("H21").Value
           Valore2 = .Range("Q3").Value
           Valore3 = Wb.Sheets("GIOCO").Range("H20").Value
           Valore4 = .Range("Q2").Value
           Valore5 = Wb.Sheets("GIOCO").Range("H19").Value
           Valore6 = .Range("Q1").Value
           Select Case IndiceRiferimento
           Case 1
             .Range("V48") = Valore1
             .Range("V49") = Valore2
             .Range("V50") = Valore3
             .Range("V51") = Valore4
             .Range("V52") = Valore5
             .Range("V53") = Valore6
           Case 2
             .Range("W48") = Valore1
             .Range("W49") = Valore2
             .Range("W50") = Valore3
             .Range("W51") = Valore4
             .Range("W52") = Valore5
             .Range("W53") = Valore6
           Case 3
             .Range("X48") = Valore1
             .Range("X49") = Valore2
             .Range("X50") = Valore3
             .Range("X51") = Valore4
             .Range("X52") = Valore5
             .Range("X53") = Valore6
           Case 4
             .Range("Y48") = Valore1
             .Range("Y49") = Valore2
             .Range("Y50") = Valore3
             .Range("Y51") = Valore4
             .Range("Y52") = Valore5
             .Range("Y53") = Valore6
           Case 5
             .Range("Z48") = Valore1
             .Range("Z49") = Valore2
             .Range("Z50") = Valore3
             .Range("Z51") = Valore4
             .Range("Z52") = Valore5
             .Range("Z53") = Valore6
           Case 6
             .Range("AA48") = Valore1
             .Range("AA49") = Valore2
             .Range("AA50") = Valore3
             .Range("AA51") = Valore4
             .Range("AA52") = Valore5
             .Range("AA53") = Valore6
           Case 7
             .Range("AB48") = Valore1
             .Range("AB49") = Valore2
             .Range("AB50") = Valore3
             .Range("AB51") = Valore4
             .Range("AB52") = Valore5
             .Range("AB53") = Valore6
           End Select
         End With
    MsgBox "Fatto!"
     End With
'<--- riattivo lo schermo, gli eventi e imposto nuovamente il calcolo in automatico --->
   With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
   End With
   End If

 End Sub

di patel data: 04/09/2016 19:08:44
temo che playsound funzioni soltanto con file .wav
inoltre se vuoi una misica continua credo che tu debba usare i midi, comunque prova questa

Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim song As String

Sub PlayOn() ' start
song = "F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3"
Call PlaySong(True)
End Sub

Sub PlayOff() ' stop
Call PlaySong(False)
End Sub

Private Sub PlaySong(Play As Boolean)
On Error Resume Next
Call mciSendString("Stop MPFE", 0&, 0, 0)
Call mciSendString("Close MPFE", 0&, 0, 0)
If Not Play Then Exit Sub
Call mciSendString("Open " & song & " Alias MPFE", 0&, 0, 0)
Call mciSendString("play MPFE from " & Reprise, 0&, 0, 0)
End Sub

di FA-BA data: 05/09/2016 15:10:28
IN EFFETTI NON VA ERRORE VARIABILE NON DEFINITA.

Quindi se converto in midi quale sarebbe?

mciSendString Lib "winmm" ESEGUE MIDI è CORRETTO??

Option Explicit
Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim song As String

Sub PlayOn() ' start
song = "F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3"
Call PlaySong(True)
End Sub

Sub PlayOff() ' stop
Call PlaySong(False)
End Sub

Private Sub PlaySong(Play As Boolean)
On Error Resume Next
Call mciSendString("Stop MPFE", 0&, 0, 0)
Call mciSendString("Close MPFE", 0&, 0, 0)
If Not Play Then Exit Sub
Call mciSendString("Open " & song & " Alias MPFE", 0&, 0, 0)
Call mciSendString("play MPFE from " & Reprise, 0&, 0, 0)
End Sub

If Sheets("GIOCO").Range("AB47") = 1 Then MsgBox "Scelte errate!": Exit Sub
    Const sIntRngOrig As String = "G6:G12"
    Const sIntRngDest As String = "C6:C12"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim IntRngOrig As Range
    Dim IntRngDest As Range
    Dim arrValori() As Variant
    Dim i As Integer, i2 As Integer
    Dim IndiceRiferimento As Integer
    Dim Valore1, Valore2, Valore3, Valore4, Valore5, Valore6
    Set Wb = ThisWorkbook
'<--- disabilito lo schermo, gli eventi e imposto il calcolo in manuale --->
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
  With Wb
         '<--- memorizzo i valori presenti in G6:G12 in una matrice --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngOrig = .Range(sIntRngOrig)
                 With IntRngOrig
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     ReDim Preserve arrValori(1 To i2)
                     arrValori(i2) = .Cells(i, 1).Value
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- riporto i valori memorizzati nella precedente matrice nelle celle C6:C12 --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngDest = .Range(sIntRngDest)
                 With IntRngDest
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     .Cells(i, 1).Value = arrValori(i2)
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- fine trasferimento in matrice / inizio conteggio macro in (I.A) CELLA AB49 --->
         With .Sheets("(I.A)")
          If .Range("AE49") = 7 Then
.Range("AE49") = 1
            .Range("W48:AB53") = Empty
         Else
           .Range("AE49") = .Range("AE49") + 1
         End If
IndiceRiferimento = .Range("AE49").Value '<--- 1,2,3,4,5,6,7
           Valore1 = Wb.Sheets("GIOCO").Range("H21").Value
           Valore2 = .Range("Q3").Value
           Valore3 = Wb.Sheets("GIOCO").Range("H20").Value
           Valore4 = .Range("Q2").Value
           Valore5 = Wb.Sheets("GIOCO").Range("H19").Value
           Valore6 = .Range("Q1").Value
           Select Case IndiceRiferimento
           Case 1
             .Range("V48") = Valore1
             .Range("V49") = Valore2
             .Range("V50") = Valore3
             .Range("V51") = Valore4
             .Range("V52") = Valore5
             .Range("V53") = Valore6
           Case 2
             .Range("W48") = Valore1
             .Range("W49") = Valore2
             .Range("W50") = Valore3
             .Range("W51") = Valore4
             .Range("W52") = Valore5
             .Range("W53") = Valore6
           Case 3
             .Range("X48") = Valore1
             .Range("X49") = Valore2
             .Range("X50") = Valore3
             .Range("X51") = Valore4
             .Range("X52") = Valore5
             .Range("X53") = Valore6
           Case 4
             .Range("Y48") = Valore1
             .Range("Y49") = Valore2
             .Range("Y50") = Valore3
             .Range("Y51") = Valore4
             .Range("Y52") = Valore5
             .Range("Y53") = Valore6
           Case 5
             .Range("Z48") = Valore1
             .Range("Z49") = Valore2
             .Range("Z50") = Valore3
             .Range("Z51") = Valore4
             .Range("Z52") = Valore5
             .Range("Z53") = Valore6
           Case 6
             .Range("AA48") = Valore1
             .Range("AA49") = Valore2
             .Range("AA50") = Valore3
             .Range("AA51") = Valore4
             .Range("AA52") = Valore5
             .Range("AA53") = Valore6
           Case 7
             .Range("AB48") = Valore1
             .Range("AB49") = Valore2
             .Range("AB50") = Valore3
             .Range("AB51") = Valore4
             .Range("AB52") = Valore5
             .Range("AB53") = Valore6
           End Select
         End With
    MsgBox "Fatto!"
     End With
'<--- riattivo lo schermo, gli eventi e imposto nuovamente il calcolo in automatico --->
   With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
   End With
   End If

 End Sub

di FA-BA data: 05/09/2016 20:28:26
??
di patel data: 05/09/2016 20:54:03
dire non va non basta, occorre dire in quale riga avviene l'errore, inoltra non funziona quella che ho allegato io o la tua ?
di FA-BA data: 05/09/2016 20:59:58
Quella che ho postato io cercando di usare il suggerimento ma ovviamente ho fatto fiasco.
Capisco che volete che tramite voi io impari dagli errori ma sarebbe più facile se "per cortesia , molto gentilmente" mi diate la macro funzionante evitiamo post in utili.

Grazie!

Ovviamente chi può e vuole rispondere, senza nessuna presunzione!

di patel data: 06/09/2016 08:42:12
hai cancellato la riga
Sub CicloConMatriceValori()

Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim song As String

Sub CicloConMatriceValori()
If Sheets("GIOCO").Range("AB47") = 1 Then MsgBox "Scelte errate!": Exit Sub
song = "F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3"
Call PlaySong(True)
    Const sIntRngOrig As String = "G6:G12"
    Const sIntRngDest As String = "C6:C12"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim IntRngOrig As Range
    Dim IntRngDest As Range
    Dim arrValori() As Variant
    Dim i As Integer, i2 As Integer
    Dim IndiceRiferimento As Integer
    Dim Valore1, Valore2, Valore3, Valore4, Valore5, Valore6
    Set Wb = ThisWorkbook
'<--- disabilito lo schermo, gli eventi e imposto il calcolo in manuale --->
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
  With Wb
         '<--- memorizzo i valori presenti in G6:G12 in una matrice --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngOrig = .Range(sIntRngOrig)
                 With IntRngOrig
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     ReDim Preserve arrValori(1 To i2)
                     arrValori(i2) = .Cells(i, 1).Value
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- riporto i valori memorizzati nella precedente matrice nelle celle C6:C12 --->
         i2 = 0
         For Each Ws In .Worksheets
           With Ws
             If .Name <> "GIOCO" And .Name <> "(I.A)" And .Name <> "NOTE" Then
               Set IntRngDest = .Range(sIntRngDest)
                 With IntRngDest
                   For i = 1 To .Rows.Count
                     i2 = i2 + 1
                     .Cells(i, 1).Value = arrValori(i2)
                   Next i
                 End With
             End If
           End With
         Next Ws
'<--- fine trasferimento in matrice / inizio conteggio macro in (I.A) CELLA AB49 --->
         With .Sheets("(I.A)")
          If .Range("AE49") = 7 Then
.Range("AE49") = 1
            .Range("W48:AB53") = Empty
         Else
           .Range("AE49") = .Range("AE49") + 1
         End If
IndiceRiferimento = .Range("AE49").Value '<--- 1,2,3,4,5,6,7
           Valore1 = Wb.Sheets("GIOCO").Range("H21").Value
           Valore2 = .Range("Q3").Value
           Valore3 = Wb.Sheets("GIOCO").Range("H20").Value
           Valore4 = .Range("Q2").Value
           Valore5 = Wb.Sheets("GIOCO").Range("H19").Value
           Valore6 = .Range("Q1").Value
           Select Case IndiceRiferimento
           Case 1
             .Range("V48") = Valore1
             .Range("V49") = Valore2
             .Range("V50") = Valore3
             .Range("V51") = Valore4
             .Range("V52") = Valore5
             .Range("V53") = Valore6
           Case 2
             .Range("W48") = Valore1
             .Range("W49") = Valore2
             .Range("W50") = Valore3
             .Range("W51") = Valore4
             .Range("W52") = Valore5
             .Range("W53") = Valore6
           Case 3
             .Range("X48") = Valore1
             .Range("X49") = Valore2
             .Range("X50") = Valore3
             .Range("X51") = Valore4
             .Range("X52") = Valore5
             .Range("X53") = Valore6
           Case 4
             .Range("Y48") = Valore1
             .Range("Y49") = Valore2
             .Range("Y50") = Valore3
             .Range("Y51") = Valore4
             .Range("Y52") = Valore5
             .Range("Y53") = Valore6
           Case 5
             .Range("Z48") = Valore1
             .Range("Z49") = Valore2
             .Range("Z50") = Valore3
             .Range("Z51") = Valore4
             .Range("Z52") = Valore5
             .Range("Z53") = Valore6
           Case 6
             .Range("AA48") = Valore1
             .Range("AA49") = Valore2
             .Range("AA50") = Valore3
             .Range("AA51") = Valore4
             .Range("AA52") = Valore5
             .Range("AA53") = Valore6
           Case 7
             .Range("AB48") = Valore1
             .Range("AB49") = Valore2
             .Range("AB50") = Valore3
             .Range("AB51") = Valore4
             .Range("AB52") = Valore5
             .Range("AB53") = Valore6
           End Select
         End With
    MsgBox "Fatto!"
     End With
'<--- riattivo lo schermo, gli eventi e imposto nuovamente il calcolo in automatico --->
   With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
   End With
   End If

 End Sub

Sub PlayOn() ' start
song = "F:GIOCOLA BATTAGLIA DEI POTENTI1.mp3"
Call PlaySong(True)
End Sub

Sub PlayOff() ' stop
Call PlaySong(False)
End Sub

Private Sub PlaySong(Play As Boolean)
On Error Resume Next
Call mciSendString("Stop MPFE", 0&, 0, 0)
Call mciSendString("Close MPFE", 0&, 0, 0)
If Not Play Then Exit Sub
Call mciSendString("Open " & song & " Alias MPFE", 0&, 0, 0)
Call mciSendString("play MPFE from " & Reprise, 0&, 0, 0)
End Sub

di FA-BA data: 06/09/2016 16:47:01
MI DAVA ERRORE UN ENF IF L'HO TOLTO NON DA ERRORI MA NON SENTO NULLA..... HO PROVATO ANCHE LA MACRO PLAY ON NULLA!!
di patel data: 06/09/2016 18:07:20
non so che dirti, a me funziona bene, ma non ho il tuo mp3
di FA-BA data: 11/09/2016 10:32:07
SE CANCELLO Sub CicloConMatriceValori() MI DA : Errore di compilazione
Non valido all'esterno di una routine

Vuoi Approfondire?