![]() |
|
![]() |
|
Thread Tools | Display Modes |
|
#1
|
|||
|
|||
![]()
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 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) 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. |
#2
|
|||
|
|||
![]()
Thank you! I'll give it a try next week and let you know how it goes!
|
![]() |
Tags |
random, sound |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
jerryny | PowerPoint | 3 | 02-10-2017 09:25 AM |
How to make a trimmed audio file play across slides | pjb2247 | PowerPoint | 2 | 12-06-2014 08:17 AM |
I get random "boing" sound on advancing slides. | talosian | PowerPoint | 2 | 04-22-2014 06:14 AM |
![]() |
maidmarion30 | PowerPoint | 1 | 10-26-2010 10:53 AM |
truncating path or renaming audio file to play in powerpoint | rbookend | PowerPoint | 0 | 05-02-2006 03:39 PM |