PDA

توجه ! این یک نسخه آرشیو شده میباشد و در این حالت شما عکسی را مشاهده نمیکنید برای مشاهده کامل متن و عکسها بر روی لینک مقابل کلیک کنید : مديا پلير در اكسل - Excel Media Player



Amir Ghasemiyan
2014/01/26, 15:58
دوستان عزيز ميخوام شما رو با قابليتي در اكسل آشنا كنم كه براي خودم خيلي جالب بود

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

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

Amir Ghasemiyan
2014/01/26, 16:09
كدهاي مربوط به هر قسمت رو هم براتون ميذارم

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




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


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




Private Sub CommandButton3_Click()
Call OpenFolder
Me.ToggleButton2 = True
End Sub


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




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


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




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

935007410
2022/05/27, 13:02
این کد اصلا فایل mp3 را که هست میگه پیدا نکردم