Salve a tutti,
Ho un problema con un macro che non vuol funzionare.
Ho realizzato un foglio excell nel quale da un menu a tendina selezionando un opzione si attiva una macro che deve visualizzare l’immagine corrispondente all’opzione scelta, prendendola da un altra pagina dello stesso file, in base ad un riferimento collegato alla selezione del menu a tendina.. Prima di incollare l’immagine nuova la macro cancella l’immagine vecchia.
La macro prima funzionava correttamente, ma adesso, dopo aver modificato il file (ma non le macro) non gira più. (Nel frattempo sono passato a Office 2010 ...)
Problemi riscontrati:
1) La macro non viene attivata dalla selezione del menu a tendina (non da segni di vita).
2) Facendo giare la macro con Run, la prima volta funziona correttamente, ma dopo non funziona più (non cancella le vecchie eimmagini e da errore).
3) Dopo aver fatto girare manualmente con Run la macro per una volta, se seleziono un nuova opzione dal menu a tendinala macro torna ad attivarsi, ma da lo stesso messaggio di eroore del punto sopra.
Per attivare le macro con la selezione del menu a tendina ho usato i seguenti comandi:
Application.ScreenUpdating = False
If Range("AJ18") <> "" Then ‘AJ18 contiene il riferimento per selezionare l’immagine
Application.EnableEvents = False
Call Imm1
Application.EnableEvents = True
Imm1 richiama la sub ImmXBody che cancella ed incolla le nuove immagini e definisce 4 variabili
PageOut è il foglio dove inserire le immagini;
CellImm è la cella dove si vuole copiare l’immagine – e cancellare la vecchia-;
PageTab è il foglio che contiene le immagini di riferimento;
CellRif è la cella che contiene i riferimenti per selezionare la nuova immagine.
La Sub che gestisce le immagini è la seguente:
Sub ImmXBody()
Application.EnableEvents = False ‘Cancella la vecchia immagine
Sheets(PageOut).Activate
OldImm = Range(CellImm).Value
If OldImm <> "" Then ActiveSheet.Shapes(OldImm).Delete
riganum = Range(CellRif).Value '<<Cerca l’immagine
Sheets(PageTab).Activate
CurPos = Range("B" & riganum).Address
For Each Pict In ActiveSheet.Shapes
If Pict.TopLeftCell.Address = CurPos Then
NomeImm = Pict.Name: Exit For
End If
Next Pict
Sheets(PageOut).Activate '<< copia l’immagine
If NomeImm = "" Then
MsgBox ("NO Immage Available") '<< message error
GoTo Uscita
End If
Sheets(PageTab).Shapes(NomeImm).Copy
Range(CellImm).Select '<< Inserisce la nuova immagine
ActiveSheet.Paste
Range(CellImm).Value = Selection.Name
Uscita:
Application.EnableEvents = True
End Sub
Il messaggio di errore che ottengo facendo girare la macro da Run è:
Run-Time error '.2147024809 (80070057)':
the item with the specified name was not found.
E cliccando su Debug mi evidenzia il comando ActiveSheet.Shapes(OldImm).Delete (evidenziato sopra in grassetto.
Mi potete aiutare?
Come posso fare?
Grazie.