Como extraer un Archivo Flash de Excel

1. Abres Excel
   
2. Herramientas
3. Macro
4. Editor Visual Basic
5. vas al cuadro de Ver codigo en la esquina izquierda
6. pega este codigo que sigue
   

Sub ExtractFlash()

Dim tmpFileName As String

Dim FileNumber As Integer

Dim myFileId As Long

Dim MyFileLen As Long

Dim myIndex As Long

Dim swfFileLen As Long

Dim i As Long

Dim swfArr() As Byte

Dim myArr() As Byte

tmpFileName = Application.GetOpenFilename("MS Office File (*.doc;*.xls;*.ppt), *.doc;*.xls;*.ppt", , "Open MS Office file")

If tmpFileName = "False" Then Exit Sub

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

If myArr(i) = &H46 Then

If myArr(i + 1) = &H57 And myArr(i + 2) = &H53 Then

swfFileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6) + CLng(&H100) * myArr(i + 5) + myArr(i + 4)

ReDim swfArr(swfFileLen - 1)

For myIndex = 0 To swfFileLen - 1

swfArr(myIndex) = myArr(i + myIndex)

Next myIndex

Exit Do

Else

i = i + 3

End If

Else

i = i + 1

End If

Loop

myFileId = FreeFile

tmpFileName = Left(tmpFileName, Len(tmpFileName) - 4) & ".swf"

Open tmpFileName For Binary As #myFileId

Put #myFileId, , swfArr

Close myFileId

MsgBox "Save the extracted SWF Flash as [ " & tmpFileName & " ]"

End Sub

1. despues que pegas el codigo vas a Ejecutar
2. Ejecutar Sub/UserForm
3. eliges el archivo donde quieres extraer el flash y listo