Macro Excel per creazione filmati timelapse
Mediante la macro Excel sotto riportata è possibile automatizzare lo scaricamento a intervalli regolari di immagini provenienti da webcam su internet.
Mettendo in sequenza le immagini tramite un programma tipo GifAnimator e intervallandole di pochi centesimi di secondo, si ottiene in riproduzione un filmato accelerato, che condensa in pochi secondi ore e ore di riprese effettive.
Questo filmato è composto da vari spezzoni, ognuno composto da circa 200 immagini scattate a intervalli di 5 minuti, per un totale di 1000 minuti (17 ore), condensati in 26 secondi, e si riferisce alla nevicata a roma del 10-11 febbraio 2012:
' Macro per la creazione di filmati timelapse. ' La macro scarica immagini da webcam pubbliche a intervalli ' regolari; è necessario successivamente utilizzare un programma ' per creazione di gif animate, per unire tutti i frame in un filmato. ' ' I file hanno nome "webcam_N_F.jpg": ' N = numero della webcam ' F = numero del frame relativo a quella webcam ' ' PROBLEMI NOTI: ' I file vengono salvati con suffisso .JPG qualunque sia il formato effettivo ' dell'immagine scaricata. ' ' Freeware - Jumpjack 2012 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' ************** Richiede MICROSOFT HTML OBJECT LIBRARY (menu STRUMENTI-->RIFERIMENTI nell'editor VBA): Public Declare Function URLDownloadToFile Lib "urlmon" Alias _ "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _ ByVal szFileName As String, ByVal dwReserved As Long, _ ByVal lpfnCB As Long) As Long Dim WEBCAMS_NUMBER As Integer Dim NUM_FRAMES As Integer Dim WebcamURL(10) As String Dim counter As Integer Const MAXFILES = 10 Dim INTERVAL As Integer Const MAX_Tentativi = 6 Dim path, strurl, nomefolder, nomefile(MAXFILES) As String Sub InitVars() '******************************************** NUM_FRAMES = 500 INTERVAL = 300 ' secondi '******************************************** WEBCAMS_NUMBER = 8 ' <<==== MODIFICARE IL NUMERO DI TELECAMERE SE SE NE AGGIUNGONO ALTRE! ' *********** INDICARE QUI GLI INDIRIZZI DELLE IMMAGINI DA SCARICARE ************************* WebcamURL(1) = "http://93.67.98.178/record/current.jpg" ' Piazza Montecitorio WebcamURL(2) = "http://www.vaticanstate.va/images/webcam/radiovaticana.jpg" ' Vaticano 1 WebcamURL(3) = "http://www2.alfa.it/italiawebcam/crop4.php?id=1552&w=800" ' Ostia WebcamURL(4) = "http://www.meteoaltatuscia.it/sanlorenzo/webcam.php" WebcamURL(5) = "http://www.vaticanstate.va/images/webcam/bracciocarlo.jpg" ' Vaticano 2 WebcamURL(6) = "http://www.meteoaltatuscia.it/marta/webcam.php" ' Bolsena WebcamURL(7) = "http://www.meteoroccapriora.it/webcam/webcam.jpg" ' RoccaPriora WebcamURL(8) = "http://www.frosinonemeteo.it/webcam/webcam.php" ' Frosinone WebcamURL(9) = "" ' *********** CARTELLA IN CUI VENGONO MEMORIZZATI I FILE ************* nomefolder = "C:\temp\" End Sub Sub ScaricaFile() Call InitVars counter = 218 ' 1 While counter <= NUM_FRAMES Tentativi = 0 For x = 1 To WEBCAMS_NUMBER Scarica (x) Debug.Print "Scaricata cam " & Str(x) & "(" & strurl & " per " & Str(counter) & " volte." DoEvents Next counter = counter + 1 SleepVBA (INTERVAL) Wend DoEvents End Sub Private Sub Scarica(x As Integer) strurl = WebcamURL(x) & "?dummy" & LTrim(Str$(counter)) nomefile(x) = nomefolder & "\webcam_" & LTrim(Str(x)) & "_" & Str(counter) & ".jpg" Cells(10, 10) = "Scarico foglio " & Str(x) & "..." DoEvents retry3: Tentativi = Tentativi + 1 errcode = URLDownloadToFile(0, strurl, nomefile(x), 0, 0) If errcode = 0 Then 'Debug.Print "OK" Else If Tentativi < MAX_Tentativi Then GoTo retry3: Else Debug.Print "############ Errore Scaricamento file '" + nomefile(x) + " " + strurl errcode = 0 End If End If End Sub Private Function zero(I As Integer) As String If I < 10 Then temp = "0" + LTrim(Str(I)) Else temp = LTrim(Str(I)) zero = temp End Function Sub SleepVBA(secs As Integer) Dim s As Integer For s = 1 To secs: Sleep 1000: DoEvents: Next End Sub
La macro salva per ogni webcam una serie di file con nome webcam_X_Y, con X che identifica la webcam e Y il fotogramma.
[…] Macro Excel per creazione filmati timelapse […]