View Single Post
 
Old 02-21-2015, 09:30 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 453
excelledsoftware will become famous soon enough
Default

Ok this wasnt as hard as I thought. There are a couple of ways to go about using the code that I am going to provide to you. I am not sure how your presentation is set or how you plan to use this code so I am giving you 3 different versions.

First off the fading of audio files is not possible in VBA unless you are fading the very end of the song. Seeing how you will be advancing the slide at a random time this is not possible. There are however third party add ons that claim they can do this.
http://www.officeoneonline.com/volctrl/volctrl.html
Is one that has several sources claiming it can do fades but I have not tried it. It has a 30 day free trial and then after that it is 20 bucks.

As far as the rest this can all be done for free with VBA.

The first set of code is 2 separate procedures the reason there are 2 procedures is because you may need to be able to call one of the functions again. I dont know since I am not aware of how your presentation is set up.

This code block uses the very last slide in the presentation to store all of the audio names. In the event that you need to keep updating this. Maybe you want to allow the user to replay the game and still prevent songs from being repeated. So make sure to insert a blank slide at the end of the presentation.

For all of the code blocks you need to set the directory which is where the sound files are coming from and you need to set all of the slides that you want a file applied to.

Code:
Option Explicit
Public pst As Presentation, DataSlide As Slide

Sub ResetSoundFileString()
  'Resest the sound file string with all sound file names
  Dim x As Integer, SoundString As String, FileName As String
  Dim StrNum As Integer, DataBox As Shape, shp As Shape
  Dim pst As Presentation, DataSlide As Slide
  
  Set pst = ActivePresentation
  Set DataSlide = pst.Slides(pst.Slides.Count)
  
  For x = 1 To 100
    StrNum = x
    Select Case StrNum
      Case 0 To 9: FileName = "HYPE00" & x & ".wav"
      Case 10 To 99: FileName = "HYPE0" & x & ".wav"
      Case 100: FileName = "HYPE" & x & ".wav"
    End Select
    SoundString = SoundString & FileName & "|"
    FileName = ""
  Next x
  SoundString = Mid(SoundString, 1, Len(SoundString) - 1)
  For Each shp In DataSlide.Shapes
    shp.Delete
  Next shp
  Set DataBox = DataSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 94.125, 61.875, 383.125, 140.875)
  With DataBox.TextFrame.TextRange
    .Font.Size = 7
    .Characters = SoundString
    .Characters.Font.Size = 7
  End With
  
End Sub


Sub ChooseRandomSong()
  'Takes the string out of databox to use for a trigger
  'Then deletes it out
  Dim x As Integer, SoundString As String, FileArray As Variant
  Dim TrackNum As Integer, SlideArray As Variant
  Dim Directory As String, pst As Presentation, DataSlide As Slide
  Set pst = ActivePresentation
  Set DataSlide = pst.Slides(pst.Slides.Count)
  Directory = "C:\Users\Admin\Desktop\"
  SoundString = DataSlide.Shapes(1).TextFrame.TextRange.Characters
  
  SlideArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) 'add in the slides that need a sound file
  
  'Check that the dataslide is not in the array
  For x = 0 To UBound(SlideArray)
    If x = DataSlide.SlideID Then
      MsgBox ("Cannot use Slide number: " & x & " in array. Program ending.")
      End
    End If
  Next x
  
  For x = 0 To UBound(SlideArray)
    FileArray = Split(SoundString, "|")
    TrackNum = Int(Rnd() * UBound(FileArray))
    pst.Slides(SlideArray(x)).SlideShowTransition.SoundEffect.ImportFromFile (Directory & FileArray(TrackNum))
    'remove the song file from future slides
    SoundString = Replace(SoundString, FileArray(TrackNum), "")
    SoundString = Replace(SoundString, "||", "|")
  Next x
  DataSlide.Shapes(1).TextFrame.TextRange.Characters = SoundString
End Sub


The 2nd way just puts it all into 1 code and does the same thing using the last slide to store the data.

Code:
Sub SetRandomSongToSlides()
  'Adds a random song into a presentation using the last slide as a data slide
  Dim x As Integer, pst As Presentation, DataSlide As Slide, TrackNum As Integer
  Dim SlideArray As Variant, FileArray As Variant, FileName As String
  Dim Directory As String, SoundString As String
  Set pst = ActivePresentation
  Set DataSlide = pst.Slides.Count
  
  'Set up data here
  SlideArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) 'add in the slides that need a sound file
  Directory = "C:\Users\Admin\Desktop\" 'Location of the sound files
  
  'add all file names to string
  For x = 1 To 100
    StrNum = x
    Select Case StrNum
      Case 0 To 9: FileName = "HYPE00" & x & ".wav"
      Case 10 To 99: FileName = "HYPE0" & x & ".wav"
      Case 100: FileName = "HYPE" & x & ".wav"
    End Select
    SoundString = SoundString & FileName & "|"
    FileName = ""
  Next x
  SoundString = Mid(SoundString, 1, Len(SoundString) - 1)
  For Each shp In DataSlide.Shapes
    shp.Delete
  Next shp
  Set DataBox = DataSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 94.125, 61.875, 383.125, 140.875)
  With DataBox.TextFrame.TextRange
    .Font.Size = 7
    .Characters = SoundString
    .Characters.Font.Size = 7
  End With
  
  
  SoundString = DataSlide.Shapes(1).TextFrame.TextRange.Characters
  
  'Check that the dataslide is not in the array
  For x = 0 To UBound(SlideArray)
    If x = DataSlide.SlideID Then
      MsgBox ("Cannot use Slide number: " & x & " in array. Program ending.")
      End
    End If
  Next x
  
  For x = 0 To UBound(SlideArray)
    FileArray = Split(SoundString, "|")
    TrackNum = Int(Rnd() * UBound(FileArray))
    pst.Slides(SlideArray(x)).SlideShowTransition.SoundEffect.ImportFromFile (Directory & FileArray(TrackNum))
    'remove the song file from future slides
    SoundString = Replace(SoundString, FileArray(TrackNum), "")
    SoundString = Replace(SoundString, "||", "|")
  Next x
  DataSlide.Shapes(1).TextFrame.TextRange.Characters = SoundString
  
End Sub
Now since that was so easy I made 1 more piece of code that will do everything for you and not even need a dataslide to store the information. This one will work right off the bat as long as you set up the slidearray and directory.

Code:
Sub SetRandomSongToSlidesNoDataSlide()
  'Adds a random song into a presentation using the last slide as a data slide
  Dim x As Integer, pst As Presentation, TrackNum As Integer
  Dim SlideArray As Variant, FileArray As Variant, FileName As String
  Dim Directory As String, SoundString As String
  Set pst = ActivePresentation
  
  'Set up the data here
  
  SlideArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) 'add in the slides that need a sound file
  Directory = "C:\Users\Admin\Desktop\" 'Location of the sound files
  
  'add all file names to string
  For x = 1 To 100
    StrNum = x
    Select Case StrNum
      Case 0 To 9: FileName = "HYPE00" & x & ".wav"
      Case 10 To 99: FileName = "HYPE0" & x & ".wav"
      Case 100: FileName = "HYPE" & x & ".wav"
    End Select
    SoundString = SoundString & FileName & "|"
    FileName = ""
  Next x
  SoundString = Mid(SoundString, 1, Len(SoundString) - 1)
  
  For x = 0 To UBound(SlideArray)
    FileArray = Split(SoundString, "|")
    TrackNum = Int(Rnd() * UBound(FileArray))
    pst.Slides(SlideArray(x)).SlideShowTransition.SoundEffect.ImportFromFile (Directory & FileArray(TrackNum))
    'remove the song file from future slides
    SoundString = Replace(SoundString, FileArray(TrackNum), "")
    SoundString = Replace(SoundString, "||", "|")
  Next x
  
  
End Sub

And there you have it. If you are unsure on how to put this code in open up your presentation SAVE A BACKUP!!!!!! then press ALT + F11.
Go to insert and select module. Copy and paste all of the code into the window.
Close out the VBA editor.

now you can assign the macro of your choice to an autoshape so when you click it runs the code and sets up the slides. if you want the user to be able to click the shape and have the show go to the next slide just add
Code:
pst.SlideShowwindow.View.GotoSlide(2)
To the end of the code block to go to the 2nd slide after the code runs. If you need a different slide change the number in parentheses.


I typed this up pretty quick and ran a couple of tests but since I do not have 100 sound files I have not tested it 100%. If there are any issues let me know.

Thanks so much for the opportunity to learn more.
Reply With Quote