Video no Excel em ASCII
Como criar um video em texto ASCII no Excel:
(arquivo para baixar no final da pagina!)
Primeiro passo:
Escolher um video e o audio dele em .WAV
Use um conversor de video para ASCII existem varios por ai, use a recomendação de video 30fps a 640x480
Segundo passo, como rodar no Excel:
Pegue os codigos gerados e coloque no excel em celulas adicionadas em linhas
copie um quadro e adicione em um range (em geral 9 colunas por 19 linhas) que caiba o quadro corretamente dentro do range sem que este fique distorcido, ajuste o zoom da planilha caso seja necessário.
incorpore o objeto wav a sua planilha (inserir>objeto>package)
Terceiro passo:
Vamos ao VBA...
Vamos chamar a "winmm.dll" para poder o wav no excel:
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Depois declarar as variaveis:
'Sound constants
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10
'Audio file
Public AudioFile As String
'Interrupt playing
Public StopPlaying As Boolean
As funções de execução do WAV:
Sub PlayBack()
WAVPlay AudioFile
End Sub
Sub PlayBackLoop()
WAVLoop AudioFile
End Sub
Sub PlayBackStop()
Call WAVPlay(vbNullString)
End Sub
Sub WAVLoop(File As String)
Dim SoundName As String
Dim wFlags As Long
Dim x As Long
SoundName = File
wFlags = SND_ASYNC Or SND_LOOP
x = sndPlaySound(SoundName, wFlags)
If x = 0 Then MsgBox "Can't play the audio file. ", vbCritical, "Error"
End Sub
Sub WAVPlay(File As String)
Dim SoundName As String
Dim wFlags As Long
Dim x As Long
SoundName = File
wFlags = SND_ASYNC Or SND_NODEFAULT
x = sndPlaySound(SoundName, wFlags)
If x = 0 Then MsgBox "Can't play the audio file. ", vbCritical, "Error"
End Sub
Agora vamos extrair o objeto WAV:
O que ele faz: procura os objetos incorporados na planilha e salva como .wav de acordo com a condição a seguir no proximo Sub
Sub ExtractWAV()
Dim tmpFileName As String
Dim FileNumber As Integer
Dim myFileId As Long
Dim MyFileLen As Long
Dim myIndex As Long
Dim FileLen As Long
Dim i As Long
Dim fileArray() As Byte
Dim myArr() As Byte
tmpFileName = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
myFileId = FreeFile
Open tmpFileName For Binary As #myFileId
MyFileLen = LOF(myFileId)
ReDim myArr(MyFileLen - 1)
Get myFileId, , myArr()
Close myFileId
Application.ScreenUpdating = False
i = 0
Do While i < MyFileLen
If myArr(i) = &H52 Then 'Looking for RIFF
If myArr(i + 1) = &H49 And myArr(i + 2) = &H46 And myArr(i + 3) = &H46 Then
FileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6) + CLng(&H100) * myArr(i + 5) + myArr(i + 4)
FileLen = FileLen + 8
ReDim fileArray(FileLen - 1)
For myIndex = 0 To FileLen - 1
fileArray(myIndex) = myArr(i + myIndex)
Next myIndex
Exit Do
Else
i = i + 4
End If
Else
i = i + 1
End If
Loop
myFileId = FreeFile
tmpFileName = AudioFile
'tmpFileName = Left(tmpFileName, Len(tmpFileName) - 4) & ".wav"
Open tmpFileName For Binary As #myFileId
Put #myFileId, , fileArray
Close myFileId
'MsgBox "Saved the extracted file as [ " & tmpFileName & " ]"
End Sub
Abrir o arquivo wave salvo ou extrair o arquivo com a função anterior (substituia o acdc.wav pelo nome do seu arquivo):
Private Sub Workbook_Open()
Dim tmpPath As String
Sheet1.Activate
tmpPath = ThisWorkbook.Path
AudioFile = tmpPath & "\ACDC.wav"
'Show logo
Sheet1.Range("B2").Value = Sheet1.Range("Q99").Value
'File exists. Do not export the embedded object.
If Dir(AudioFile) <> "" Then Exit Sub
Call ExtractWAV
DoEvents
End Sub
Agora sim a função para "rodar" o video, que constitue nada mais nada menos que uma timer para exibir os frames convertidos no mesmo timing do video
Sub PlayVideo()
Dim i As Long
Dim Start, Delay
i = 100
Do While Sheet1.Cells(i, 17).Value <> ""
Start = Timer 'Set start to internal timer
Delay = Start + 0.083 'Set delay so frames change 12 per sec.
'Display
Do While Timer < Delay
DoEvents
Loop
Sheet1.Range("B2").Value = Sheet1.Cells(i, 17).Value
DoEvents
If StopPlaying = True Then
Exit Do
End If
Start = Timer 'and reset the timer
Delay = Start + 0.083 'and the delay
i = i + 1
Loop
'Stop audio
Call PlayBackStop
'Clear video
Sheet1.Range("B2").Value = ""
'Show logo
Sheet1.Range("B2").Value = Sheet1.Range("Q99").Value
'Move cursor
'Sheet1.Range("A1").Select
End Sub
para rodar precisamos de mais isto no planilha agora:
para dar o play (rodar o wav e chamar o playvideo
Private Sub btnPlay_Click()
StopPlaying = False
If Trim(AudioFile) = "" Then AudioFile = ThisWorkbook.Path & _
"\ACDC.wav"
Call PlayBackLoop
DoEvents
Call PlayVideo
End Sub
Para parar o video
Private Sub btnStop_Click()
StopPlaying = True
End Sub
apenas para não ficar selecionado o range do video...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Left(Replace(Target.Address, "$", ""), 2) = "B2" Then
Range("B22").Select
End If
End Sub
E pronto!!! Video no excel!