Extraer archivo swf

hola, Alexa !

Trabajo con Office 2007 como debo hacer para extraer un archivo swf incrustado en un archivo xls ?

el siguiente codigo proviene de un foro de excel en chino (nunca lo he probado)
(aparentemente) el archivo .xls debe ser de version anterior a 2007
y debes seleccionarlo (SIN abrirlo) en el dialogo que muestra la misma macro

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

nota: OJO con los saltos de linea segun tu lector de noticias...

Sub ExtraerFlash()
Dim Nombre_tmp As String, IdArchivo As Long, LargoArchivo As Long, Pos As Long, _
Largo_swf As Long, n As Long, Matriz_swf() As Byte, Matriz_x() As Byte
Nombre_tmp = Application.GetOpenFilename( _
"Archivos MS Office (*.doc;*.xls), *.doc;*.xls", , "Abrir Archivos Word / Excel")
If Nombre_tmp = "False" Then Exit Sub Else Application.ScreenUpdating = False
IdArchivo = FreeFile: Open Nombre_tmp For Binary As #IdArchivo: LargoArchivo = LOF(IdArchivo)
ReDim Matriz_x(LargoArchivo - 1): Get IdArchivo, , Matriz_x(): Close IdArchivo
Do While n < LargoArchivo
If Matriz_x(n) = &H46 Then
If Matriz_x(n + 1) = &H57 And Matriz_x(n + 2) = &H53 Then
Largo_swf = CLng(&H1000000) * Matriz_x(n + 7) + _
CLng(&H10000) * Matriz_x(n + 6) + _
CLng(&H100) * Matriz_x(n + 5) + _
Matriz_x(n + 4)
ReDim Matriz_swf(Largo_swf - 1)
For Pos = 0 To Largo_swf - 1: Matriz_swf(Pos) = Matriz_x(n + Pos): Next: Exit Do
Else: n = n + 3
End If
Else: n = n + 1
End If
Loop: Nombre_tmp = Left(Nombre_tmp, Len(Nombre_tmp) - 4) & ".swf": IdArchivo = FreeFile
Open Nombre_tmp For Binary As #IdArchivo: Put #IdArchivo, , Matriz_swf: Close IdArchivo
MsgBox "El archivo Flash-SWF ha sido extraido y guardado como: " & Nombre_tmp
End Sub

Otra opcion cuya autoria, lamentablemente, no recuerdo :(

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), *.doc;*.xls", , "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 < MyFileLen
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

Abraham

Esto me funcionó a la perfección

http://www.taringa.net/posts/ebooks...er-un-SWF-(animaci%C3%B3n-de-flash),-de-un-documento-W.html



"Abraham" escribió en el mensaje
news:

Otra opcion cuya autoria, lamentablemente, no recuerdo :(

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), *.doc;*.xls", , "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 < MyFileLen
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

Abraham

hola, chicos !

cualquiera que haga "analisis" de codigos, podra notar que todos son "el mismo"
y pueden acercarse (un poquitin mas) al origen del mismo (p.e.)
desde alguno de los siguientes vinculos (entre muchos mas):

http://www.excelba.com/Art/Html/272.html
http://beau.tw/read-87.html
http://dndpk.spaces.live.com/blog/cns!F78C4C2882FDB928!130.entry
http://blog.chinaunix.net/u/21854/s...75697.html
http://cat14051.mysinablog.com/inde...cleIdU5049

saludos,
hector.