اول فایل اکسل خودتونو تبدیل به فرمت قدیمی اکسل یعنی xls کنید، بعد یه فایل اکسل جدید درست کنید تو صفحه کلید های alt + f11 رو بزنید یه فرم VBA براتون باز میکنه کد زیر رو توش کپی کنید
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
و بعد f5 رو برای اجرا بزنید ازتون آدرس فایل xls همون اکسلی که توش فلش دارید رو میخواد بعد بغل همون فایل بهتون فایل فلش رو تحویل میده
بنده رسما دیگه فعالیتی تو این سایت ندارم، به علت چیزهایی که دیدم در سایت زومایت و همچنین اینجا بخصوص چیزهایی که از مدیران این وبسایتها شنیدم! همیشه کمک کردن به دوستان در حد خودم رو دوست داشتم ولی با توجه به اهداف این سایت ها برام منطقی نیست دیگه اینجا حضور داشته باشم بهتره جایی ادم حضور پیدا کنه که آدماش بی رنگ باشن نه رنگارنگ، امیدوارم یه روزی یه روزی ایران دوباره ایران بشه و هواش قابل تنفس، بدرود