كود لكيفية تغيير امتدادات الملفات====>>

أخ عرفة إسمح لي ألقي بدلوي زي ما بيقولوا باللغى العربية الفسحة:P

معلش أنا محتاج زبط زوايا الأيام دى، بس مش مشكل، طنش اللغة و فوتها ;)

مشاركة كدة من ناحيتى، مش تعديل عليك يا حبيبي و لا حاجة، حاشا و كَلْهَا

بس عشان الفايدة تعم (gift)

m_change.zip

السلام عليكم

ملاحظة ..... أرجو من الجميع قبل وضع الملف المرفق الخاص بأى كود .. أن يقوموا بوضع الكود بالمنتدى حتى يتسنى للجميع مشاهدة الكود دون الحاجة لتحميل الملف ومن ثم فتحه ..

أرجو الإنتباه

و

مشكورين جميعا

تحياتى

تحية من Roka للفاروق، أنا على قد ما أفتكر مكنتش توليت مسئولية الاشراف آخر مرة كنت فيها في المنتدى قبل فترة الانقطاع اللي فاتت لي، و لو الموضوع دة جديد يبقى مبروك.

بالنسبة لطلبك دة، مش شايف انه ممكن يكون له شوية آثار جانبية ;) منها إنه ينفع لو الكود عبارة عن إجراء صغنطوت مثلا "اخفاء مؤشر الماوس" أو شئ من هذا القبيل و لكن هل تقترح وضع كود مشروع كامل عبارة عن كذا فورم و كام موديول ، و كل واحد يعدل في المشروع يكتب في رده نص المشروع بالكامل تاني؟ طيب و لو المشروع فيه أدوات مطلوبة و مرفقة أو صور أو أي ملفات تانية محتاجها الكود عشان يشتغل، اية المانع من تحميل الملفات، مش حاجة جديدة علينا، حتى عشان يخف الحمل على الاعضاء بدل ما نضغط عليهم فى انتظار تحميل صفحات بطيئة بسبب دسامتها من كثرة الاكواد المصقة بدون داعى.

و متفهمش الموضوع انه معارضة للمعارضة بس انا حبيت اقول رأيي.

و عموماً

Option Explicit

'ÊÚÏíá ÈÓíØ ãä ÃÎæß / ãÍãÏ ÝÇÑæÞ ÇáÓíÏ ãÍãÏ íæäÓ

'áÊÚÙíã ÇáÝÇÆÏÉ

'ÞÏ ÊÍÏË ãÔßáÉ ãÚ ÃÓãÇÁ ÇáãáÝÇÊ ÇáØæíáÉ

'ÃÝíÏæäÇ ÈäÊÇÆÌ ÊÌÇÑÈßã¡ ÞãÊ ÈÊäÝíÐ ÇáÊÚÏíá ÇáãÞÊÑÍ Ýí ÍæÇáí 10 ÏÞÇÆÞ

'æ ÇáÞÕÏ Çäå áã íÍÙì ÈÇáæÞÊ ÇááÇÒã ááÊÌÑÈÉ



Private Sub Command1_Click()

    Dim I As Integer

    Dim Y As Integer

    Dim Z As Integer

    Dim FileNames$()

    

    Dim Mynewext As String

    Dim MyFileName As String

    Dim MyNewFileName As String

    

    Dim ErrMsg As String

    Dim ErrMsgTitle As String

    

    On Error GoTo Errhandler

    

    CommonDialog1.DialogTitle = "ÊÍæíá ÇáãáÝÇÊ"

    CommonDialog1.FileName = ""

    CommonDialog1.Filter = "MP3|*.MP3"

    CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNLongNames ' áÇ ÊÖãä cdlOFNExplorer

    CommonDialog1.CancelError = True

    CommonDialog1.MaxFileSize = 32760 'áÊßÈíÑ ÇáÜ Buffer

    CommonDialog1.ShowOpen

    

    CommonDialog1.FileName = CommonDialog1.FileName & Chr(32)

    Mynewext = "txt"

    

    Z = 1

    For I = 1 To Len(CommonDialog1.FileName)

        I = InStr(Z, CommonDialog1.FileName, Chr(32))

        If I = 0 Then Exit For

        ReDim Preserve FileNames(Y)

        FileNames(Y) = Mid(CommonDialog1.FileName, Z, I - Z)

        Z = I + 1

        Y = Y + 1

    Next

    

    For I = 0 To Y - 1

        If I <> 0 Then

           MyFileName = FileNames(I)

           MyNewFileName = Mid$(MyFileName, 1, Len(MyFileName) - 3) & Mynewext

           Name MyFileName As MyNewFileName

        End If

    Next



MsgBox "Êã ÊäÝíÐ ÊÛííÑ ÇãÊÏÇÏ: " & Y - 1 & " ãáÝ.", vbOKOnly, "ÇÚáÇã ÈÇäÊåÇÁ ÇáÊäÝíÐ"

Exit Sub



Errhandler:

    ErrMsg = "ÍÏË ÎØà ÃËäÇÁ ÊäÝíÐ ÇáÇÌÑÇÁ" & vbNewLine & "æÕÝ ÇáÎØÃ:" & vbNewLine

    ErrMsgTitle = "ÎØÃ ÑÞã: " & Err.Number

    Select Case Err.Number

    Case cdlCancel

        ErrMsg = ErrMsg + "ÞÇã ÇáãÓÊÎÏã ÈÅáÛÇÁ ÇáÚãáíÉ"

    Case Else

        ErrMsg = ErrMsg + "ÎØà ÛíÑ ãÊæÞÚ¡ ÑÇÌÚ ÑÞã ÇáÎØà Ýí ÚäæÇä ÇáÑÓÇáÉ"

    End Select

    MsgBox ErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, ErrMsgTitle

End Sub





Private Sub Command2_Click()

    Dim I As Integer

    Dim Y As Integer

    Dim Z As Integer

    Dim FileNames$()

    

    Dim Mynewext As String

    Dim MyFileName As String

    Dim MyNewFileName As String

    

    Dim ErrMsg As String

    Dim ErrMsgTitle As String

    

    On Error GoTo Errhandler

    

    CommonDialog1.DialogTitle = "ÊÍæíá ÇáãáÝÇÊ"

    CommonDialog1.FileName = ""

    CommonDialog1.Filter = "TXT|*.TXT"

    CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNLongNames ' áÇ ÊÖãä cdlOFNExplorer

    CommonDialog1.CancelError = True

    CommonDialog1.MaxFileSize = 32760 'áÊßÈíÑ ÇáÜ Buffer

    CommonDialog1.ShowOpen

    

    CommonDialog1.FileName = CommonDialog1.FileName & Chr(32)

    Mynewext = "MP3"

    

    Z = 1

    For I = 1 To Len(CommonDialog1.FileName)

        I = InStr(Z, CommonDialog1.FileName, Chr(32))

        If I = 0 Then Exit For

        ReDim Preserve FileNames(Y)

        FileNames(Y) = Mid(CommonDialog1.FileName, Z, I - Z)

        Z = I + 1

        Y = Y + 1

    Next

    

    For I = 0 To Y - 1

        If I <> 0 Then

           MyFileName = FileNames(I)

           MyNewFileName = Mid$(MyFileName, 1, Len(MyFileName) - 3) & Mynewext

           Name MyFileName As MyNewFileName

        End If

    Next



MsgBox "Êã ÊäÝíÐ ÊÛííÑ ÇãÊÏÇÏ: " & Y - 1 & " ãáÝ.", vbOKOnly, "ÇÚáÇã ÈÇäÊåÇÁ ÇáÊäÝíÐ"

Exit Sub



Errhandler:

    ErrMsg = "ÍÏË ÎØà ÃËäÇÁ ÊäÝíÐ ÇáÇÌÑÇÁ" & vbNewLine & "æÕÝ ÇáÎØÃ:" & vbNewLine

    ErrMsgTitle = "ÎØÃ ÑÞã: " & Err.Number

    Select Case Err.Number

    Case cdlCancel

        ErrMsg = ErrMsg + "ÞÇã ÇáãÓÊÎÏã ÈÅáÛÇÁ ÇáÚãáíÉ"

    Case Else

        ErrMsg = ErrMsg + "ÎØà ÛíÑ ãÊæÞÚ¡ ÑÇÌÚ ÑÞã ÇáÎØà Ýí ÚäæÇä ÇáÑÓÇáÉ"

    End Select

    MsgBox ErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, ErrMsgTitle

End Sub



Private Sub Command3_Click()

    End

End Sub

و معلش عشان اللغة العربية مشفرة، مفيش وقت أظبطها.

سلام.