VBA 如何在每张幻灯片上重复代码以编辑第一个文本框?

VBA How can I repeat code on every slide to edit the FIRST text box?

我正在为 Powerpoint 编写 VB 代码。它从幻灯片上的 SECOND 文本框中检索日期并计算距该日期的天数。然后计算的天数显示在 FIRST 文本框中。尽管文本框的名称与第一张幻灯片的名称相同,但我无法获取要在第二张幻灯片中重复的代码。

'Sets variables
Dim Sdate As Long
Dim thedate As Date
Dim txt As Date
Dim pptSlide3 As Slide

Do
 For Each pptSlide3 In ActivePresentation.Slides

   Set sld = ActivePresentation.SlideShowWindow.View.Slide

 'Retrieves D-Day from corresponding text box


  TextBox2.Font.Size = 36
   thedate = TextBox2.Text

'Calculates the amount of time from today's date until D-day above
Sdate = DateDiff("d", Now(), thedate)

'Creates textbox with the value of how many days are left
TextBox1.Value = Sdate & "  Days to go!"
TextBox1.Font.Size = 36

'Want it to wait 5 seconds here
   ' Goes to next slide

With SlideShowWindows(1).View
    If sld.SlideIndex < 4 Then
    .GotoSlide (sld.SlideIndex + 1)
    End If

    If sld.SlideIndex = 4 Then
    .GotoSlide (1)
    End If
End With

  Next pptSlide3
  Loop

试试这样的方法:

Do
 For Each pptSlide3 In ActivePresentation.Slides

 'Retrieves D-Day from corresponding text box

  TextBox2.Font.Size = 36
  thedate = pptSlide3.Shapes("TextBox2").OLEFormat.Object.Text

'Calculates the amount of time from today's date until D-day above
Sdate = DateDiff("d", Now(), thedate)

'Creates textbox with the value of how many days are left
pptSlide3.Shapes("TextBox1").OLEFormat.Object.Text = Sdate & "  Days to go!"
TextBox1.Font.Size = 36

'Want it to wait 5 seconds here
   ' Goes to next slide

With SlideShowWindows(1).View
    If pptSlide3.SlideIndex < 4 Then
    .GotoSlide (pptSlide3.SlideIndex + 1)
    End If

    If pptSlide3.SlideIndex = 4 Then
    .GotoSlide (1)
    End If
End With

  Next pptSlide3
  Loop