VBA 在 MAC Os 上的 PowerPoint 中不执行任何操作

Question

我想知道是否有人可以帮助我使此代码在我的 MAC 中工作。我最近两次发布了这个查询，但我没有得到解决方案。因为知道为 MAC 编写 VBA 的 VBA 专家很少。

这是我在 Windows PowerPoint 中完美使用的 VBA 宏代码。但现在我最近搬到了 MAC OS。我希望这个文件也能在 Mac 上运行。

不幸的是！它不工作并且没有错误消息当我在 MAC 版本 big sur (11.6.2) 和 Microsoft Office PowerPoint 版本 365 上运行此宏时没有任何反应。

这是它的代码：

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

注意：

• 代码存储 PowerPoint 幻灯片名称以及幻灯片打开时间和幻灯片关闭时间。

• 详细信息存储在 Excel 工作表中。

• 当我在 MAC 上运行时，代码不起作用。

我知道需要进行一些更改才能使其在 Mac 上运行，但到目前为止，我已经找到任何人帮助我很好地修改此代码。

我请求 VBA 专家提供任何帮助。

Answer 1

CreateObject 在 PowerPoint for Mac 对象模型中已损坏。请将此问题报告给 Microsoft，如果他们收到几千个请求，他们可能会最终修复它。

将您的代码粘贴到幻灯片上，以便他们看到。然后点击程序窗口右上角的“person-with-speech-bubble”图标并选择我不喜欢某事。描述问题，包括你的代码截图并提交。他们不太可能回复，但这是你能做的最好的。

Answer 2

最后，经过一番努力和编辑，我设法在我的 MAC 上运行了这段代码。

代码如下：

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

感谢任何改进建议。