Archive for the ‘Microsoft Office’ Category

VBA: Create Slide for every Picture in a Folder

Wednesday, November 23rd, 2011

This short script runs in PowerPoint VBA. It looks in a given folder for any image and creates a new slide for that image. Once the image has been inserted it determines if the image is portrait or landscape and then resizes the picture, keeping the proportions, to fit the given slide layout as best it can.  

Option Explicit
Sub CreatePictureSlidesByFolder()
    'Define Variables
    Dim PictureFolder As String
    Dim CurrentSlide As Slide
    Dim CurrentFile As String
    Dim CurrentFileFullName As String
    Dim AllowedExtensions() As Variant
   
    'Set the Path to the folder of pictures
    PictureFolder = "\\data\staffdata\ctolley\My Pictures\Sample Pictures"
   
    'Check that the Picture folder path has a trailing \
    If Right(PictureFolder, 1) <> "\" Then PictureFolder = PictureFolder & "\"
   
    'Define the allowed picture extensions
    AllowedExtensions = Array("jpg", "png", "bmp")
   
    'Check that 1 slide exists in the presentation
    If ActivePresentation.Slides.Count = 0 Then
        ActivePresentation.Slides.Add 1, ppLayoutTitle
        ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = PictureFolder
    End If
   
    'Get the files in the folder
    CurrentFile = Dir(PictureFolder)
   
    While CurrentFile <> ""
   
    'Check that the file extension is allowed
    If IsStringInArray(GetFileExtension(CurrentFile), AllowedExtensions) Then
   
        'Make the full file name
        CurrentFileFullName = PictureFolder & CurrentFile
   
        'Add a new slide to the presentation
        Set CurrentSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
       
        'Add the picture to the presentation
        With CurrentSlide.Shapes.AddPicture(CurrentFileFullName, msoFalse, msoTrue, 0, 0)
       
            'Check if the picture is landscape or portrait
           
            If .Width > .Height Then
                'Landscape
                .Width = ActivePresentation.PageSetup.SlideWidth
                .Left = 0
                .Top = (ActivePresentation.PageSetup.SlideHeight - .Height) / 2
           
            Else
                'Portrait
                .Height = ActivePresentation.PageSetup.SlideHeight
                .Left = (ActivePresentation.PageSetup.SlideWidth - .Width) / 2
                .Top = 0
            End If
           
        End With
       
    End If
           
    'Clear the current file
    CurrentFile = Dir
   
    Wend
End Sub
Public Function GetFileExtension(TheFilePath As String) As String
    'Separates the file extension from the file name and returns it.
    Dim FileParts() As String
    FileParts = Split(TheFilePath, ".")
    GetFileExtension = FileParts(UBound(FileParts))
End Function
Public Function IsStringInArray(TheString As String, TheArray() As Variant) As Boolean
    'Determines if the passed string is in the passed array.
    Dim ArrIdx As Integer
    For ArrIdx = LBound(TheArray) To UBound(TheArray)
        If TheString Like TheArray(ArrIdx) Then IsStringInArray = True
    Next ArrIdx
End Function

VBA: Create PowerPoint Slide for Each Row in Excel Workbook

Wednesday, June 8th, 2011

This may seem like a really weird thing to want to do. Imagine this though: You want a presentation to show off the names of a lot of students on a constant loop at a kiosk, and you don’t want to have to retype the names. VBA to the rescue.

This little snippet of code will do the following:

  1. Open a given Excel Document
  2. For Each used row in column A of sheet 1, create a copy the first slide in the presentation.
  3. Change the text of the first text box to the content of that cell

Easy. Here it is:

Sub CreateSlides()
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx")
'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Set WS = OWB.Worksheets(1)
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlUp).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
   
    'Change the text of the first text box on the slide.
    ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value
Next
End Sub

Paste this into a new module inside your PowerPoint presentation. You will need to add in a reference to Microsoft Excel Objects (Tools -> References). Change the name and location of the Excel file that you want to use.

If you set up the first slide exactly as you want it before running the macro, then the same formats and layout will be copied too. Alternatively use Slide Masters to set up all the slides after they have been created.

4 people found this post useful.

Could Not Open file.doc from SharePoint Server 2010

Monday, June 6th, 2011

I have found a couple of solutions to this on the web, but nothing like this.

We have SharePoint Server 2010 and Office 2010. I was browsing to a file located on My Site, but other documents . Excel or Word would open and then i would be told:

Could not open filename.doc

You would then click ok, the message disappeared and you would not have an open document.

In our case, it was nothing to do with IE security settings, or Office 2010 protected mode.

We had been trialling SharePoint WorkSpace with a copy f my My Site attached so that I could work on my MySite documents at home. The copy that was stored on my computer had not been updated as I had disabled the option to start SharePoint WorkSpace after I was happy that it would work.

The fix for me therefore was to either delete the local sync copy or to have it update the local copy.

Back to be able to get my work.

1 person found this post useful.