Home > Net >  VBA does nothing in PowerPoint on MAC Os
VBA does nothing in PowerPoint on MAC Os

Time:01-26

I wonder if there is someone who can help me make this code work in my MAC. I recently posted this query two times but I got no solution. Because there are very few VBA experts who know to write VBA for MAC.

So here is the VBA Macro Code which I'm using in my Windows PowerPoint perfectly. But now I've recently moved to MAC OS. And I want this same file to work on Mac as well.

Unfortunately! Its not working and there is no Error message And nothing happening when I run this Macro on MAC version big sur (11.6.2) and, Microsoft Office PowerPoint version 365.

Here is the Code for it:

Dim slideShowRunning As Boolean
Dim counter As Integer
Dim st As Dat
Dim i As Integer
Dim sttime As Date
Dim oxlapp As Object
Dim oxlwb As Object
Dim oxlws As Object
Dim edtime As Date

Sub SlideShowBegin(ByVal Wn As SlideShowWindow)
  st = Date
  sttime = Time
  counter = 0
  Debug.Print " works;1 "
  Set oxlapp = CreateObject("Excel.Application")
  Debug.Print " works; 2"
  oxlapp.Visible = False
  Debug.Print " works; 3"
  Set oxlwb = oxlapp.Workbooks.Open(ActivePresentation.Path & Application.PathSeparator & "record.xlsx")
  Debug.Print " works; 4"
  Set oxlws = oxlwb.Sheets("TimeRecord")
  Debug.Print " works; 5"
  i = oxlws.Range("A99919").End(-4162).Row
  oxlws.Range("A1").Offset(i, 0).Value = st
  oxlws.Range("A1").Offset(i, 1).Value = sttime
  Debug.Print " works; 6"
End Sub

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
  If TypeName(slideShowRunning) = "Empty" Or slideShowRunning = False Then
    slideShowRunning = True
    SlideShowBegin Wn
  End If
End Sub

Public Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
  Name = Application.ActivePresentation.Name
  slideShowRunning = False
  edtime = Time
  Debug.Print " works; 7"
  ivalue = DateDiff("s", sttime, edtime)
  Debug.Print ivalue
  oxlws.Range("A1").Offset(i, 2).Value = edtime
  oxlws.Range("A1").Offset(i, 3).Value = ivalue
  oxlws.Range("A1").Offset(i, 4).Value = Name
  Debug.Print " works; 9"
  oxlapp.DisplayAlerts = False
  Debug.Print " works; 10"
  oxlwb.Save
  Debug.Print " works; 11"
  oxlapp.Visible = True
  Debug.Print " works; 12"
  oxlapp.DisplayAlerts = True
  Debug.Print " works; 13"
End Sub

Note:

  • The code stores the PowerPoint slide Name along with slide opening time and slide closing time.

  • The details are stored in an Excel Sheet.

  • The code doesn't work when I run it on MAC.

I know there are few changes that need to be done to make it work on Mac but till now I've find anyone to help me modifying this code well.

I request VBA Experts for any kind of Help.

CodePudding user response:

CreateObject is broken in the PowerPoint for Mac object model. Please report this to Microsoft, perhaps if they get a few thousand requests, they'll finally fix it.

Paste your code onto a slide, so they can see it. Then click on the "person-with-speech-bubble" icon in the upper right corner of the program window and choose I don't like something. Describe the problem, include a screenshot of your code and submit. They are unlikely to reply, but it's the best you can do.

CodePudding user response:

Finally, after some struggle and editing, I managed to run this code on my MAC.

Here is the code:

Dim slideShowRunning As Boolean
Dim counter As Integer
Dim st As Date
Dim i As Integer
Dim sttime As Date
Dim oxlapp As Object
Dim oxlwb As Object
Dim oxlws As Object
Dim edtime As Date

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
If TypeName(slideShowRunning) = "Empty" Or slideShowRunning = False Then
    slideShowRunning = True
    st = Date
    sttime = Time
    counter = 0
    Set oxlapp = CreateObject("Excel.Application")
     oxlapp.Visible = False
     Set oxlwb = oxlapp.Workbooks.Open(ActivePresentation.Path & "/" & "record.xlsx")
     Set oxlws = oxlwb.Sheets("TimeRecord")
     i = oxlws.Range("A99919").End(-4162).Row
     oxlws.Range("A1").Offset(i, 0).Value = st
     oxlws.Range("A1").Offset(i, 1).Value = sttime
End If
End Sub

Public Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
Name = Application.ActivePresentation.Name
    slideShowRunning = False
    edtime = Time
    Debug.Print " works; 7"
    ivalue = DateDiff("s", sttime, edtime)
    Debug.Print ivalue
    oxlws.Range("A1").Offset(i, 2).Value = edtime
    oxlws.Range("A1").Offset(i, 3).Value = ivalue
    oxlws.Range("A1").Offset(i, 4).Value = Name
    Debug.Print " works; 9"
    
    oxlapp.DisplayAlerts = False
      Debug.Print " works; 10"
    oxlwb.Save
      Debug.Print " works; 11"
   ' oxlwb.Close
   oxlapp.Visible = True
      Debug.Print " works; 12"
    oxlapp.DisplayAlerts = True
   
      Debug.Print " works; 13"
  End Sub

Any improvement suggestion appreciated.

  •  Tags:  
  • Related