Блог

хорошо, так что я застрял на некоторое время и не знаю, как решить эту проблему.

Ситуация: у меня есть файл Excel с данными, в котором я отфильтровываю данные, которые хочу экспортировать. Там у меня уже есть макрос, который экспортирует мне выделение в PowerPoint (и это работает просто отлично).

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

Я понимаю основы того, как работает генератор случайных чисел, но я далеко не понимаю, как применить это к моему случаю, и где я должен вставить генератор в код.

Вот мой код для преобразования Excel в PPT.

 Sub XLS_to_PPT()

Dim pptPres As Presentation
Dim strPfad As String
Dim strPOTX As String
Dim pptApp As Object
Dim strSave As String



strPfad = Application.ActiveWorkbook.Path
strPOTX = "Credential_PPT_Template.pptx"
strSave = Application.ActiveWorkbook.Path

Set pptApp = New PowerPoint.Application


pptVorlage = strPfad amp; "" amp; strPOTX

pptApp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue


Set pptPres = pptApp.ActivePresentation

For Each tableRow In Sheets("Credentials").ListObjects("Credential_Submission").DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
Set newSlide = pptPres.Slides(1).Duplicate
newSlide.Shapes("PMOTeamSize").TextFrame.TextRange.Characters.Text = tableRow.Columns(69).Value
newSlide.Shapes("TeamSize").TextFrame.TextRange.Characters.Text = tableRow.Columns(65).Value
newSlide.Shapes("Header").TextFrame.TextRange.Characters.Text = tableRow.Columns(4).Value
newSlide.Shapes("ClientChanlenge").TextFrame.TextRange.Characters.Text = tableRow.Columns(75).Value
newSlide.Shapes("HowWeHelped").TextFrame.TextRange.Characters.Text = tableRow.Columns(76).Value
newSlide.Shapes("ClientBenefitsDelivered").TextFrame.TextRange.Characters.Text = tableRow.Columns(77).Value


Next tableRow

pptPres.Slides(1).Delete

pptPres.SaveAs strSave amp; "" amp; ("New_Request")



pptPres.Close

Set pptPres = Nothing
Set pptApp = Nothing

End Sub
 

Одним из подходов является:

 Public Function GetRandImageFile(imFolder As String) As String
    Static list As Collection
    Static lastFolder As String
    
    If list Is Nothing Or lastFolder <> imFolder Then
        On Error GoTo out
        lastFolder = imFolder
        Set list = New Collection
        cnt = 0
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set fd = fs.getfolder(lastFolder)
        For Each f In fd.Files
            pos = InStrRev(f.Name, ".")
            ext = ""
            If pos > 0 Then ext = LCase(Mid(f.Name, pos))
            Select Case ext
                Case ".jpg", ".png", ".bmp" ' and so on
                    list.Add f.Name, CStr(cnt)
                    cnt = cnt   1
            End Select
        Next
    End If
    
    Randomize
    slash = IIf(Right(lastFolder, 1) <> "", "", "")
    GetRandImageFile = lastFolder amp; slash amp; list(Rnd() * (list.Count - 1)   1)
out:
End Function