طريقة إستخراج ملف فلاش من ملف وورد أو إكسل

[جلال محمد]

الأخوة الكرام

السلام عليكم

لقد اعجبتنى كثيرا مجموعة الساعات الفلاشية المقدمة من اخى الكريم خبور

واثناء بحثي في احدى المواقع وجدت طريقه شيقة لاستخراج ملف الفلاش من الاكسل او الورد ولقد اعجبنى الشرح المقدم فنقلته كما هو لتعم الفائدة على الجميع ان شاء الله

ولتسائل البعض عن كيفية ادراج ملف فلاشى في الاكسل فقد قدم الاستاز ( aah_aah2008 ) في مشاركة سابقة شرح الطريقة

واليكم ملفين لشرح طريقة الاستخراج وطريقة الادراج

وللجميع تحياتى

__________________________________________.rar

Ramadan.rar

[نزار سليمان عيد]

السلام عليكم

جزاك الله خيرا اخي جلال وزادك علما

مع الشكر

ابو خالد

[جلال محمد]

اخى الكريم / نزار سليمان عيد

شكرا لك لك على مرورك وجزى الجميع خيرا

واليكم الكود الخاص باستخراج ملف الفلاش من الاكسل او الورد وشرح طريقة العمل بملف فديو

وشكرا لكم

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

____________.rar

[أبو جديد]

ألف شكر لك أخي / galal_mk

طريقة ممتازة

الله يعطيك العافية

[عادل حنفي]

السلام عليكم

اخي galal_mk

بارك الله فيك بالفعل كود جميل بالرغم من انه طويل جدا

و نقدر تعبك جزاك الله كل خير و قد تمت التجربة و هو يعمل و الحمد لله

خالص تحياتي و تقديري

تم تعديل أبريل 15, 2009 بواسطه aah_aah2008

[جلال محمد]

اخى الكريم / مزلزل

جزاك الله خير وشكرا على مرورك

اخى الكريم / aah_aah2008 بارك الله لك وللجميع فالمنتدى عامر بمجموعة عظيمه عطائه وانت واحد منهم شكرا لك وللجميع