Hide or Unhide Slides based on Linked-Object Cell Value-CodePudding

I'm trying to come up with a way to dynamically hide or unhide slides in a powerpoint that I have to do every week. To hasten things up I am using 'linked macro-enabled worksheet object' pasted items in the powerpoint presentation, the text formatting is done in excel.

I can do the trick with slide numbers, but it is not sure the slide numbers won't change in the future and I want to be as specific as possible.

Each slide that is to be automated has a 'linked macro-enabled worksheet object' that I named 'x' in the selection pane in powerpoint.

If the cell that links to object 'x' is empty or 0, the slide should be hidden.

If there is no object 'x' on a slide, or the cell that links to the object 'x' on this specific slide has a value that isn't 0 or empty, the slide shouldn't be hidden.

Currently my cod:

Private Sub CommandButton1_Click()

'Declare variables
Dim oPPT As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oExcel As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet

On Error GoTo ErrorHandler

'Set variables
Set oExcel = GetObject(, "Excel.Application")

'Loop through open workbooks
For Each oWorkbook In oExcel.Workbooks

'Check if workbook has correct name
If oWorkbook.Name = "Zaro.xlsm" Then

Set oWorksheet = oWorkbook.Sheets("ShowHide")
Set oPPT = GetObject(, "PowerPoint.Application")
Set oPres = oPPT.ActivePresentation

'Loop through slides
For Each oSlide In oPres.Slides

'Loop through objects in slide
For Each oObject In oSlide.Shapes

'Check if object is a linked object
If oObject.Type = msoLinkedOLEObject Then

'Check if object name is "x"
If oObject.Name = "x" Then

'Get cell value for object
Dim cellValue As String
cellValue = oWorksheet.Range(oObject.OLEFormat.ProgID).Value

'Check if cell is empty
If IsEmpty(cellValue) Then
  Debug.Print "Hiding slide " & oSlide.SlideIndex & " because cell is empty."
  oSlide.SlideShowTransition.Hidden = msoTrue
Else
  Debug.Print "Showing slide " & oSlide.SlideIndex & " because cell is not empty."
  oSlide.SlideShowTransition.Hidden = msoFalse
End If

End If

End If

Next oObject

Next oSlide

End If

Next oWorkbook

Exit Sub

ErrorHandler:
Debug.Print "An error occurred: " & Err.Description

End Sub

I tried to come up with some sort of debugging solution, to no avail.

I am totally stuck as to why it isn't doing anything. Better yet, I asked openAI ChatGPT and the AI couldn't solve it either.

Thanks for any insights.

CodePudding user response：

With titles you can do this actually easily.

Tested, and it works for me:

 Sub HideUnhideSlides()

Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet
Dim pptSlide As Slide

Set xlApp = GetObject(, "Excel.Application")
Set xlWorkbook = xlApp.Workbooks("Zaro.xlsm")
Set xlWorksheet = xlWorkbook.Worksheets("ShowHide")

For Each pptSlide In ActivePresentation.Slides
    If pptSlide.Shapes.HasTitle Then
        If xlWorksheet.Cells(pptSlide.SlideNumber, 1).Value = 1 And pptSlide.Shapes.Title.TextFrame.TextRange.Text = xlWorksheet.Cells(pptSlide.SlideNumber, 2).Value Then
            pptSlide.SlideShowTransition.Hidden = msoTrue
        ElseIf xlWorksheet.Cells(pptSlide.SlideNumber, 1).Value = 2 And pptSlide.Shapes.Title.TextFrame.TextRange.Text = xlWorksheet.Cells(pptSlide.SlideNumber, 2).Value Then
            pptSlide.SlideShowTransition.Hidden = msoFalse
        End If
    End If
Next pptSlide

End Sub