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.
