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! |
Pagina Inicial > Excel >