• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 330
  • Last Modified:

Need a custom macro for Powerpoint 2010

Hi All,

I need to program a macro into a powerpoint 2010 ribbon button for a few users.

Basically they have 3 powerpoint presentations with either 1 or 2 slides each. We then need to be able to save every slide as a JPG file in a specific directory with some additional logic, in preparation for a script to pick it up and upload it to a server.

Please see the attached image for the logic that I would like the button to follow.

Basically it needs to take the name of the current opened .pptx file and then save all the slides in that current powerpoint to a specific directory and ensure that the naming convention is always the same (taken from the file name).

If someone would be able to create this macro for me that'd be great.

Please feel free to ask for anything that may require clarification.

Cheers

 logic
0
agbnielsen
Asked:
agbnielsen
  • 7
  • 4
1 Solution
 
RobSampsonCommented:
Hi, if you run this code:
Sub SaveAsJPG
    ActivePresentation.SaveAs Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1), ppSaveAsJPG, msoFalse
End Sub

Open in new window


It will create a folder called the same name as the presentation file, and inside that it will have Slide1.JPG, Slide2.JPG, etc.

If that suits what you want for the most part, we can build the rest of the logic in pretty easily.

Regards,

Rob.
0
 
agbnielsenAuthor Commented:
Hi Rob,

Mate I wont be able to test till Monday but looks like we are on the right track.

Just a quick substitution - could we modify it to put it in a predefined folder name (in the flowchart I have called it C:\directory so that will do, I can change it later) and instead of calling it slide1, slide2 etc. can we use the name of the file?

So it would be like <presentation.name1.jpg>, <presentation.name2.jgp).

Fingers crossed!

Cheers
0
 
RobSampsonCommented:
We could...I suspect though that because we can't override the default save behaviour of Powerpoint's Save As JPG feature, we might have to make do with saving it to a temporary location, then doing all the modifications we need as we move it to the right place.

Let me know how that sounds.

Rob.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
agbnielsenAuthor Commented:
Hmmm... sounds like a bit too much work.

Let's wait until Monday and I'll do some testing. If I can get away with it the way you have programmed the macro we will just do that.

Cheers
0
 
RobSampsonCommented:
Well, I believe if you substitute this bit:
Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1)

with a folder name, it will output the images to that folder, then we'd just need to rename each image in that folder after it has saved.

So if you use:
Sub SaveAsJPG()
    ActivePresentation.SaveAs "C:\Temp\NewImages", ppSaveAsJPG, msoFalse
End Sub

Open in new window


it will save Slide1.JPG, Slide2.JPG, etc to the folder C:\Temp\NewImages

So you can point it to any folder, but we'd still need to rename the files to prefix the files with the presentation name.

Anyway, I've combined that together, so see how this goes.

Regards,

Rob.
Sub SaveAsJPG()
    strPresentationName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1)
    strImageFolder = "C:\Temp\NewImages"
    If Right(strImageFolder, 1) = "\" Then strImageFolder = Left(strImageFolder, Len(strImageFolder) - 1)
    ActivePresentation.SaveAs strImageFolder, ppSaveAsJPG, msoFalse
    strFile = Dir(strImageFolder & "\*.JPG")
    While strFile <> ""
        Name strImageFolder & "\" & strFile As strImageFolder & "\" & strPresentationName & "_" & strFile
        strFile = Dir()
    Wend
End Sub

Open in new window

0
 
RobSampsonCommented:
Hi, I had a bit more time, and have hopefully fulfilled all of the logic you requested.

Regards,

Rob.
Sub SaveAsJPG()
    strPresentationName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1)
    strImageFolder = "C:\Temp\NewImages"
    If Right(strImageFolder, 1) = "\" Then strImageFolder = Left(strImageFolder, Len(strImageFolder) - 1)
    If Dir(strImageFolder, vbDirectory) = "" Then MkDir strImageFolder
    blnContinue = False
    If Dir(strImageFolder & "\" & strPresenatation & "*.JPG") <> "" Then
        intResponse = MsgBox("Images for " & strPresentationName & " already exist. Do you want to overwrite?", vbYesNo, "Overwrite?")
        If intResponse = vbYes Then
            blnContinue = True
            Kill strImageFolder & "\" & strPresenatation & "*.JPG"
        End If
    Else
        blnContinue = True
    End If
    If blnContinue = True Then
        ActivePresentation.SaveAs strImageFolder, ppSaveAsJPG, msoFalse
        strFile = Dir(strImageFolder & "\*.JPG")
        strFileList = ""
        While strFile <> ""
            Name strImageFolder & "\" & strFile As strImageFolder & "\" & strPresentationName & "_" & strFile
            If strFileList = "" Then
                strFileList = strPresentationName & "_" & strFile
            Else
                strFileList = strFileList & vbCrLf & strPresentationName & "_" & strFile
            End If
            strFile = Dir()
        Wend
        MsgBox "Files in " & strImageFolder & " have been created for " & strPresentationName & vbCrLf & strFileList
    Else
        MsgBox "Files have not been overwritten."
    End If
End Sub

Open in new window

0
 
agbnielsenAuthor Commented:
Perfect!!!!

Bloody legend, cheers!
0
 
RobSampsonCommented:
No worries. Thanks for the grade.

Rob.
0
 
RobSampsonCommented:
Hi, I have decided to test this on a couple of presentations here at work, and found a couple typos!  First, I have an extra "a" in strPresentationName, and second, I had strPresentation instead of strPresentationName in a couple of spots.

Try this out now, it should work more accurately.

Rob.
Sub SaveAsJPG()
    strPresentationName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1)
    strImageFolder = "C:\temp\Temp\Test script\PresentationTest\Images"
    If Right(strImageFolder, 1) = "\" Then strImageFolder = Left(strImageFolder, Len(strImageFolder) - 1)
    If Dir(strImageFolder, vbDirectory) = "" Then MkDir strImageFolder
    blnContinue = False
    If Dir(strImageFolder & "\" & strPresentationName & "*.JPG") <> "" Then
        intResponse = MsgBox("Images for " & strPresentationName & " already exist. Do you want to overwrite?", vbYesNo, "Overwrite?")
        If intResponse = vbYes Then
            blnContinue = True
            Kill strImageFolder & "\" & strPresentationName & "*.JPG"
        End If
    Else
        blnContinue = True
    End If
    If blnContinue = True Then
        ActivePresentation.SaveAs strImageFolder, ppSaveAsJPG, msoFalse
        strFile = Dir(strImageFolder & "\Slide*.JPG")
        strFileList = ""
        While strFile <> ""
            Name strImageFolder & "\" & strFile As strImageFolder & "\" & strPresentationName & "_" & strFile
            If strFileList = "" Then
                strFileList = strPresentationName & "_" & strFile
            Else
                strFileList = strFileList & vbCrLf & strPresentationName & "_" & strFile
            End If
            strFile = Dir()
        Wend
        MsgBox "Files in " & strImageFolder & " have been created for " & strPresentationName & vbCrLf & strFileList
    Else
        MsgBox "Files have not been overwritten."
    End If
End Sub

Open in new window

0
 
agbnielsenAuthor Commented:
Beautiful. Thank you.
0
 
RobSampsonCommented:
No worries.  Things are better when they work aren't they ;-)
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now