PowerPoint/Excel VBA Linked data RRS feed

  • Question

  • Hello

    I have a project Im working on.

    PPT has slides 1 to 20  that are suppose to be dynamically populated via Links to Excel.

    In Excel, I have 50 sheets, each sheet contains Rows 3 to 22 that have words in them  (all the same range for all sheets).

    In PPT, Ive created 1 Textbox on each slide that contains the dynamic words from Excel.

    Slide 1 contains 50 buttons (each button linked to one of the 50 sheets in excel.

    Nearly all of it works, except, each button I click opens a new workbook and so the words on the slides don't change because it defaults to the first open workbook.

    I've put in a function that checks to see if the workbook is open or not, and if it is, it's simply suppose to copy a range of cells from the appropriate sheet in excel to a "data" sheet in excel (which is where the slides in PPT are linked to).

    So, if the function is False (workbook is not open), it should run through the code, open it, minimize it and copy the appropriate content to the "Data" sheet.  If the function is True, it suppose to bypass opening the workbook and simply copy the appropriate range to the "Data" sheet.

    The button captions are the same name as the excel worksheets (Group 1-1, Group 1-2 etc).

    I have included the ability to figure out where the ppt file is being opened from, so that updating the links works correctly (it's pretty raw, but it works for my application).

    Here's my code:

    Option Explicit
    Dim XlApp As Object
    Dim Wb As Workbook
    Dim upPath
    Dim Curpth
    Dim xlIsStarted As Boolean
    Dim clkdbutton As Object
    Sub OpenFiles(Sheetnme)
    Dim xWb As Workbook
    Dim upath
    Dim a
    If Not Module1.AlreadyOpen("Frye Words Excel Sheet.xlsx") = True Then
        upath = ""
        Curpth = ""
        Set XlApp = CreateObject("Excel.Application")
        Curpth = Application.ActivePresentation.path
        XlApp.Visible = True
        a = Right(Curpth, 1)
        If a = "\" Then
        upPath = Curpth & "Frye Words Excel Sheet.xlsx"
        XlApp.Workbooks.Open Curpth & "Frye Words Excel Sheet.xlsx", True, False
        'xlIsStarted = True
        'Set Wb = XlApp.Workbooks("Frye Words Excel Sheet.xlsx")
        XlApp.WindowState = xlMinimized
        Else: upPath = Curpth & "\Frye Words Excel Sheet.xlsx"
        XlApp.Workbooks.Open Curpth & "\Frye Words Excel Sheet.xlsx", True, False
        'Set Wb = XlApp.Workbooks("Frye Words Excel Sheet.xlsx")
        End If
       XlApp.Worksheets(Sheetnme).Range("A3:A22").Copy Destination:=XlApp.Worksheets("LinkData").Range("A3")
       'Else: XlApp.Worksheets(Sheetnme).Range("A3:A22").Copy Destination:=XlApp.Worksheets("LinkData").Range("A3")
       Call test
       End If
       XlApp.Worksheets(Sheetnme).Range("A3:A22").Copy Destination:=XlApp.Worksheets("LinkData").Range("A3")
       XlApp.WindowState = xlMinimized
    End Sub
    Sub test()
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim pptPresentation As PowerPoint.Presentation
    Set pptPresentation = ActivePresentation
    For Each PPTSlide In pptPresentation.Slides
        If PPTSlide.Name <> "Slide23" Then
        For Each PPTShape In PPTSlide.Shapes
           If PPTShape.Type = msoLinkedOLEObject Then
           Call UpdateLinks(ActivePresentation.Slides.Range(Array(PPTSlide.Name)))
           End If
       Next PPTShape
       End If
    Next PPTSlide
    End Sub
    Sub UpdateLinks(oSlideRange As SlideRange)
        Dim oSl As Slide
        Dim oSh As Shape
        Dim path, position, fname, x, y, Filename
        For Each oSl In oSlideRange
            For Each oSh In oSl.Shapes
                If oSh.Type = msoLinkedOLEObject Then
                    path = oSh.LinkFormat.SourceFullName
                    position = InStr(1, path, "!", vbTextCompare)
                    fname = Left(path, position - 1)
                    Filename = upPath & "!LinkData!"
                    x = InStr(1, path, "!", vbTextCompare)
                    x = InStr(x + 1, path, "!", vbTextCompare)
                    y = Mid(path, x + 1, Len(path) - x + 1)
                    Filename = upPath & "!LinkData!" & y
                    oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, path, Filename)
                End If
    End Sub
    Private Sub CommandButton1_Click()
    Set clkdbutton = Me.CommandButton1
    Call OpenFiles(clkdbutton.Caption)
    End Sub
    Private Sub CommandButton10_Click()
    Set clkdbutton = Me.CommandButton10
    Call OpenFiles(clkdbutton.Caption)
    End Sub
    '  48 more commandbuttons do the same thing.

    My Function is located at "Module1"  -- Thanks to Allen Wyatt on

    Function AlreadyOpen(sFname As String) As Boolean
        Dim wkb As Workbook
        On Error Resume Next
        Set wkb = Workbooks(sFname)
        AlreadyOpen = Not wkb Is Nothing
        Set wkb = Nothing
    End Function

    So, Im not sure why it opens a new book each time, because it should bypass the workbook open portion of my script and copy the data.

    Also, even though I tell excel to mininize, it pops up for about 4 seconds before minimizing.

    Any help would be appreciated.

    Thank You


    Saturday, February 29, 2020 9:18 PM

All replies

  • I think you've made it too complicated. I wouldn't use links between office apps for anything. It relies too much on old outdated windows DDE technology that is not reliable and often leads to file corruption.

    Firstly I understand there is one Excel workbook with 50 Worksheets.

    Personally, I would:

    1. In the first window with the 50 buttons for each button's event code I would record which button has been clicked based on the name of the button and save in a Global variable the name of the matching worksheet.
    2. Call an UpdatePresentation sub in a Module to do the work.
    3. Have a Workbook variable, EG Wrkbk and if its nothing then the file isn't open. Open it and set the visible property to false. If the workbook is already open, opening again, especially if you do so in read only mode, still works.
    4. Now all your code needs to do is read the relevant text from the worksheet and write into the relevant textboxes in your slides.
    5. Close the Workbook and set the Wrkbk variable to Nothing.

    You will need a reference to Excel in the VBE

    This code will run faster and more reliably and should be easier to understand and maintain.

    Happy programming!

    Rod Gill
    Author of the one and only Project VBA Book and VBA developer.

    Saturday, February 29, 2020 10:34 PM