Vba PowerPoint宏从当前日期获取下一个星期四的日期_Vba_Date_Macros_Powerpoint

Vba PowerPoint宏从当前日期获取下一个星期四的日期

vba date macros

Vba PowerPoint宏从当前日期获取下一个星期四的日期,vba,date,macros,powerpoint,Vba,Date,Macros,Powerpoint,我想从当前日期中找出下周四的日期，并写在第一张幻灯片中。到目前为止，我已经知道了当前的日期，但我没有找到下周四的日期。例如，我在2016年8月23日（星期二）打开演示文稿，当我的宏运行时，我希望在第一张幻灯片上看到2016年8月25日（对应于星期四）到目前为止，我已经： Set objPPTX = CreateObject("PowerPoint.Application") objPPTX.Visible = True 'Adding Date on First Slide Set PPAp

我想从当前日期中找出下周四的日期，并写在第一张幻灯片中。到目前为止，我已经知道了当前的日期，但我没有找到下周四的日期。例如，我在2016年8月23日（星期二）打开演示文稿，当我的宏运行时，我希望在第一张幻灯片上看到2016年8月25日（对应于星期四）

到目前为止，我已经：

Set objPPTX = CreateObject("PowerPoint.Application")
objPPTX.Visible = True
'Adding Date on First Slide 
Set PPApp = GetObject(, "Powerpoint.Application")
    Set PPPres = PPApp.ActivePresentation
    PPApp.ActiveWindow.ViewType = ppViewSlide
    PPApp.Visible = True
     Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Set PPshape = PPSlide.Shapes.AddShape(Type:=msoShapeRectangle, Left:=220, Top:=150, Width:=270, Height:=75)
 Set PPshape1 = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=20, Top:=150, Width:=680, Height:=70)
 With PPshape1
 .TextFrame.TextRange.Text = "PT PM Weekly"
 .TextFrame.TextRange.Font.Name = "Verdana"
 .TextFrame.TextRange.Font.Color = vbBlack
 .TextFrame.TextRange.Font.Size = 48
 End With

 Set PPshape = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=350, Top:=150, Width:=680, Height:=70)
With PPshape


Todate = DateValue(Now)
oldWeekDay = Weekday(Now)
Select Case Thursday

Case oldWeekDay = 1
.TextFrame.TextRange.Text = Format(Now + 4, " dd.mm.yyyy")
Case oldWeekDay = 2
.TextFrame.TextRange.Text = Format(Now + 3, " dd.mm.yyyy")
Case oldWeekDay = 3
.TextFrame.TextRange.Text = Format(Now + 2, " dd.mm.yyyy")
Case oldWeekDay = 4
.TextFrame.TextRange.Text = Format(Now + 1, " dd.mm.yyyy")
Case oldWeekDay = 5
.TextFrame.TextRange.Text = Format(Now, " dd.mm.yyyy")
Case oldWeekDay = 6
.TextFrame.TextRange.Text = Format(Now - 1, " dd.mm.yyyy")
Case oldWeekDay = 7
.TextFrame.TextRange.Text = Format(Now - 2, " dd.mm.yyyy")

End Select

.TextFrame.TextRange.Font.Name = "Verdana"
.TextFrame.TextRange.Font.Color = vbBlack
.TextFrame.TextRange.Font.Size = 48
End With

但最后我只得到了当前日期的+4，所以我认为问题在于案例结构。

类似的内容会有所帮助，请阅读工作日帮助

Function NEXT_THURSDAY(dtFrom As Date) As Date

Dim intCurrentDay As Integer

intCurrentDay = Weekday(dtFrom, vbThursday)

NEXT_THURSDAY = DateAdd("d", 8 - intCurrentDay, dtFrom)

End Function

类似的内容会有所帮助，请阅读工作日帮助

Function NEXT_THURSDAY(dtFrom As Date) As Date

Dim intCurrentDay As Integer

intCurrentDay = Weekday(dtFrom, vbThursday)

NEXT_THURSDAY = DateAdd("d", 8 - intCurrentDay, dtFrom)

End Function

我认为您误解了

Select Case

语句的语法

你从

Select Case Thursday

但您尚未定义星期四，因此VBA将假定此新变量等于0

你的第一个病例是

Case oldWeekDay = 1

但是

Case

后面应该跟一个值，而不是一个比较。VBA正在计算比较值

oldWeekDay=1

，如果为false，则将其转换为0。因此，第一种情况将始终执行，除非

oldWeekDay

实际上等于1

我想你想写的是

Select Case oldWeekDay
    Case 1
    .TextFrame.TextRange.Text = Format(Now + 4, " dd.mm.yyyy")

等等

请注意，如果在VBA模块的顶部添加语句

Option Explicit

，则会出现

选择案例

行的

变量未定义

错误。出于这种原因，强烈建议始终使用

选项Explicit

。