Получение номера недели в PowerPoint

Question

У меня есть код для создания PowerPoint с файлом Excel. Я в основном изменил код в соответствии с моим требованием, но я хочу добавить еще одну функцию в мой .ppt. Я хочу VBA извлечь номер недели из какого-либо источника и выполните следующие действия:

1. Переименовать мой .ppt как «XXX_Weeknumber.ppt»
2. В одном из текстовых полей в слайдах, которые я хочу добавить такую ​​же НомерНеделю.

Я попытался получить номер недели с помощью функции WeekNum и попытаться вызвать функцию в моем основном Sub, но, к сожалению, не работает!

Мой код для функции в модуле 1:

Function WeekNum(D As Date) As Integer 
WeekNum = CInt(Format(D, "ww", 2)) 
End Function 

Код для .xls в .ppt в модуле 2:

Dim oPPTApp As PowerPoint.Application 
Dim oPPTShape As PowerPoint.Shape 
Dim oPPTShape2 As PowerPoint.Shape 
Dim oPPTFile As PowerPoint.Presentation 
Dim PPSlide As PowerPoint.slide 
Dim SlideNum As Integer 
Dim rng As Range 
Dim WeekNumm$ 


Sub PPTableMacro() 
Dim sourcexl As Workbook 

Dim wk As Integer 

Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String 
strExcelFilePath = "C:\MySource.xls" 
strPresPath = "C:\Presentation1.ppt" 
Call WeekNum 
WeekNumm = WeekNum() 
Set wk = WeekNumm 
strNewPresPath = "C:\Presentation1_" & wk & ".ppt" 'This is how I want the name 
strNewPresPath = "C:\new1.ppt" 

Set oPPTApp = CreateObject("PowerPoint.Application") 
oPPTApp.Visible = msoTrue 

Set oPPTFile = oPPTApp.Presentations.Open(strPresPath) 
SlideNum = 2 

oPPTFile.Slides(SlideNum).Select 
Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table 1") 

Set sourcexl = Workbooks.Open(strExcelFilePath) 'Source excel file 
With sourcexl 
.Sheets("Sheet1").Activate 
oPPTShape.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = Cells(1, 1).Text 
oPPTShape.Table.Cell(1, 2).Shape.TextFrame.TextRange.Text = Cells(1, 2).Text 
oPPTShape.Table.Cell(1, 3).Shape.TextFrame.TextRange.Text = Cells(1, 3).Text 
oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = Cells(2, 1).Text 
oPPTShape.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = Cells(2, 2).Text 
oPPTShape.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = Cells(2, 3).Text 

End With 

Set oPPTShape2 = oPPTFile.Slides(SlideNum).Shapes("TextBox 1") 
Text1 = "weekXX" ' actually wanted week number here 
oPPTShape2.TextFrame.TextRange.Text = Text1 

oPPTFile.SaveAs strNewPresPath 
'oPPTFile.Close 
'oPPTApp.Quit 

Set oPPTShape = Nothing 
Set oPPTFile = Nothing 
Set oPPTApp = Nothing 

MsgBox "Presentation Created", vbOKOnly + vbInformation 

End Sub 

Answer 1

Ваша функция запрашивает ввод данных ("D") , и это необязательно. Если вы хотите, чтобы получить день недели сегодня (системная переменная «Дата»), вы должны назвать это так:

WeekNumm = WeekNum(Date) 

Кроме того, вы используете заявление Set в «Set WK = WeekNumm». Поскольку переменная не является объектом, вы должны использовать (предпочтительно опущен) Let.

Кроме того, ваша функция не вернет день недели, так как «ww» означает номер недели в году. Если вы хотите, чтобы день недели был таким путем, вы должны использовать «w».

Для лучшего подхода вы должны использовать встроенную функцию Weekday, чтобы получить будний день.

Как:

iWeekDay = Weekday(Date,vbUseSystemDayOfWeek) 'Retrieves today's day of the week (Tuesday = 3...)