مديا پلير در اكسل - Excel Media Player

[935007410]

این کد اصلا فایل mp3 را که هست میگه پیدا نکردم

[Amir Ghasemiyan]

كدهاي مربوط به هر قسمت رو هم براتون ميذارم

كدهاي مربوط به انتخاب پوشه و انتخاب كردن تمام آهنگ ها و فيلم هاي داخل اون پوشه

[LEFT]
Sub OpenFolder()
    'choose the folder where the music files are stored:
    Dim fldr As FileDialog
    Dim folder As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select Your Music Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    folder = sItem
    Set fldr = Nothing
    
    UserForm2.Label1.Caption = folder
    
    'add the names of the files in the listbox:
    Dim fso As Object
    Dim fo As Object
    Dim fi As Object
    'clear list first:
    UserForm2.ListBox1.Clear
    'add items:
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.GetFolder(folder & "\")
    For Each fi In fo.Files
    ' check if mp3 or not
    If Right(fi.Name, 3) = "mp3" Or Right(fi.Name, 3) = "wav" Or Right(fi.Name, 3) = "m4a" Then
        UserForm2.ListBox1.AddItem fi.Name
    ElseIf Right(fi.Name, 3) = "FLV" Or Right(fi.Name, 3) = "flv" Or Right(fi.Name, 3) = "avi" Or Right(fi.Name, 3) = "wmv" Or Right(fi.Name, 3) = "mp4" Then
        UserForm2.ListBox1.AddItem fi.Name
    End If
   Next
   
   Set fi = Nothing
   Set fo = Nothing
   Set fso = Nothing
   
   If UserForm2.ListBox1.ListCount = 0 Then MsgBox "No Mp3 files were found in this folder, choose another folder."
End Sub[/LEFT]

كدهاي مربوط به دكمه انتخاب پوشه:

[LEFT]Private Sub CommandButton3_Click()
    Call OpenFolder
    Me.ToggleButton2 = True
End Sub
[/LEFT]

كدهاي مربوط به نشان دادن و ليست فايل ها:

[LEFT]
Private Sub ToggleButton2_Click()
    If Me.ToggleButton2.Value = False Then
        Me.Height = 87.75
        Me.ToggleButton2.Caption = "More >>"
    Else
        Me.Height = 195.75
        Me.ToggleButton2.Caption = "Less <<"
    End If
End Sub[/LEFT]

و مهمترين قسمت، يعني كدهاي مربوط به اجراي فايل ها:

[LEFT]Private Sub ListBox1_Click()
    Dim lItem As Long
    For lItem = 0 To ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lItem) = True Then
            playMusic ListBox1.List(lItem)
        End If
    Next
End Sub

Function playMusic(lItems As String)
    UserForm2.WindowsMediaPlayer1.URL = UserForm2.Label1.Caption & "\" & lItems
    UserForm2.WindowsMediaPlayer1.Controls.Play
End Function[/LEFT]

[Amir Ghasemiyan]

دوستان عزيز ميخوام شما رو با قابليتي در اكسل آشنا كنم كه براي خودم خيلي جالب بود

شما داخل فايل اكسل ميتونين يك مديا پلير قوي داشته باشيد. من براتون يك فايل آماده كردم كه طريقه استفاده از اين قابليت رو نشون ميده

اميدوارم لذت ببريد