CODEWITHSUNDEEP
excelexcel-formulaexcel-2007vba
maf-soft
maf-soft

Reputation: 2552

Automatically include image and sound files in excel columns, based on a filename in another column

I have a column with filenames in my excel file.

In the same folder of the excel file, I have image files in the form of that filename + '.jpg'. Also I have small mp3 files with the same filename + '.mp3'.

Now I want the image for each row to be displayed in a new column, and a play-button to play the mp3 file, in another column.

I already know the "=HYPERLINK()" function - with it, I can construct the path and link to the files. If I had a formula, which returns the objects itself, instead of only a link, this would be much better.

Is this possible?

Ideally, the multimedia files stay outside the excel file. But if it's much easier to embed the files, that is acceptable, too.

Also some non-formula-method would be ok, like some vba script, which loops over all rows.

EDIT: I found the following working code to play .wav files. I could convert all the mp3 files - any better idea?

Private Declare Function sndPlaySound Lib "winmm.dll" _
 Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
 ByVal uFlags As Long) As Long
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10

Sub Test()
    If sndPlaySound("C:\WINDOWS\Media\tada.wav", SND_ASYNC Or SND_NODEFAULT) = 0 Then
        MsgBox "Unable to play sound."
    End If
End Sub

I also still need to find out how to insert a Button and run this code from it...

Upvotes: 0

Views: 1627

Answers (2)

user3514930
user3514930

Reputation: 1717

OK :-)))) I have already worked for you, because it's an interesting questions.
Use this code inside a Module.
Configuration:
Column A: Name.
Column B: Image.
Column C: Object Embedded. ERASED.
Column D: Button to Play.

Declaration:

Private Declare Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Dim sMusicFile As String
Dim Play

If you need a Stop Button:

Public Sub cmdStopMusic_Click()
    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Create the Sequence of Image and Button Objects:
You can call every time you want, it's already implemented the check the presence of line already inserted... (Upgrade !!!)

Sub CreateMP3()
    For i = 1 To 9999
        If Range("A" & i).Value = "" Then Exit For

        FoundT = False
        For e = 1 To ActiveSheet.Shapes.Count
            If ActiveSheet.Shapes.Range(e).Top = Range("C" & i).Top And ActiveSheet.Shapes.Range(e).Left = Range("C" & i).Left Then
                FoundT = True
            End If
        Next
        If FoundT = False Then
            ActiveSheet.Pictures.Insert("e:\0\A\xx\" & Range("A" & i).Value & ".jpg").Select
            Selection.ShapeRange.Top = Range("B" & i).Top
            Selection.ShapeRange.Left = Range("B" & i).Left
            Selection.ShapeRange.Height = Range("B" & i).Height

            BottoniMP3 (i)
        End If
    Next
End Sub

Creation of the Button:
In this sub you create also the connection with the action of the button. Only one action for many button...

Sub BottoniMP3(NumB As Integer)
    Dim xx As Range

    Set xx = Range("D" & NumB)
    ActiveSheet.Buttons.Add(xx.Left, xx.Top, xx.Width, xx.Height).Select
    Selection.OnAction = "'SoundMP3 """ & NumB & """'"
    Selection.Characters.Text = Range("A" & NumB).Value
End Sub

Event for the Button:
The event have a parameter to pass the number of row...

Sub SoundMP3(xx As Integer)
    ' Stop the Prev...
    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
    If Play <> 0 Then MsgBox "Can't PLAY!"
End Sub

CleanUp:
Pay attention to the parameter passed, if you delete some rows can be better to CleanUp the Sheet and rebuild:

Sub ERASEALL()
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        Select Case ActiveSheet.Shapes(i).Name
            Case "Button 86":
            Case "Button 87":
            Case "Button 88":
            Case Else:
                ActiveSheet.Shapes(i).Delete
        End Select
    Next
End Sub

The Case Button xxx are the button I don't want to be erased. For example are the button I use to reduilt the sheet.
If you prefer you can pass like a parameter the name of the MP3, in that case I think you don't have prb... As you want.

FINAL !!! ;-))):
If you prefer you can add a Shape insted of Image & Button. The Shape follow the Cell dimensions:

Private Declare Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Dim sMusicFile As String

Dim PlayN

Sub xxxxMP3Sh()
    For i = 1 To 9999
        If Range("A" & i).Value = "" Then Exit For

        FoundT = False
        For e = 1 To ActiveSheet.Shapes.Count
            If ActiveSheet.Shapes.Range(e).Top = Range("B" & i).Top And ActiveSheet.Shapes.Range(e).Left = Range("B" & i).Left Then
                FoundT = True
            End If
        Next
        If FoundT = False Then
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("B" & i).Left, Range("B" & i).Top, Range("B" & i).Width, Range("B" & i).Height).Select
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .UserPicture "e:\0\A\xx\" & Range("A" & i).Value & ".jpg"
                .TextureTile = msoFalse
            End With
            Selection.OnAction = "'SoundMP3Sh """ & i & """'"
        End If
    Next
End Sub

Sub SoundMP3Sh(xx As Integer)
    ' Stop the Prev...
    PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    PlayN = mciSendString("play " & sMusicFile, 0&, 0, 0)
    If PlayN <> 0 Then MsgBox "Can't PLAY!"
End Sub

Sub StopPl()
        PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Also I have learned a lot !!!! Good Job
Long Filename & path:
Add in the Module:

Private Declare Function GetShortPathName Lib "kernel32" Alias _
  "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal _
  lpszShortPath As String, ByVal lBuffer As Long) As Long

And in the code change the sub:

Public Function GetShortPath(ByVal sLongPath As String) As String
    Dim sShortPath  As String
    sShortPath = VBA.String(260, 0)
    If GetShortPathName(sLongPath, sShortPath, Len(sShortPath)) Then
        GetShortPath = VBA.Left(sShortPath, _
                   VBA.InStr(sShortPath, vbNullChar) - 1)
    End If
End Function

Sub SoundMP3Sh(xx As Integer)
    ' Stop the Prev...
    PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    sMusicFile = GetShortPath(sMusicFile)
    PlayN = mciSendString("play " & Chr(34) & sMusicFile & Chr(34), 0&, 0, 0)
    If PlayN <> 0 Then MsgBox "Can't PLAY!"
End Sub

Upvotes: 1

user3514930
user3514930

Reputation: 1717

I think, with formula, you can have only a link...
A code like:

For i = 1 To 9999
    If Range("A" & i).Value = "" Then Exit For

    ActiveSheet.Pictures.Insert("e:\0\xx\" & Range("A" & i).Value & ".jpg").Select
    Selection.ShapeRange.Top = Range("B" & i).Top
    Selection.ShapeRange.Left = Range("B" & i).Left
    Selection.ShapeRange.Height = Range("B" & i).Height

    ActiveSheet.OLEObjects.Add(Filename:="e:\0\xx\" & Range("A" & i).Value & ".mp3", Link:=False, DisplayAsIcon:=False).Select
    Selection.ShapeRange.Top = Range("c" & i).Top
    Selection.ShapeRange.Left = Range("c" & i).Left
    Selection.ShapeRange.Height = Range("c" & i).Height

Next

Import Picture and MP3 starting from A1 to ... Using Column B for Image and Column C for the Object.
To lissen the sound you need to doble click on the object.
If you want a Button, the code are a little bit more complicated...
Notes:
You need to run the macro after you have built the column "A" with the name. If you want to run every time you change the files (add) you need to add a check for the row already made...

Upvotes: 1

Related Questions