Чтобы создать презентацию в PowerPoint на тему "История космонавтики" с использованием VBA, напишу для вас скрипт, который автоматически сгенерирует десять слайдов с разными моментами истории космических полетов. В каждом слайде будет заголовок и некоторое краткое описание события.
Sub СоздатьПрезентациюКосмонавтики() ' Создание новой презентации Dim ppApp As Object Dim ppPres As Object Dim ppSlide As Object Dim slideIndex As Integer ' Проверка, запущен ли PowerPoint On Error Resume Next Set ppApp = GetObject(, "PowerPoint.Application") If ppApp Is Nothing Then Set ppApp = CreateObject("PowerPoint.Application") ppApp.Visible = True End If On Error GoTo 0 ' Создание новой презентации Set ppPres = ppApp.Presentations.Add ' Слайды презентации Dim titlesAndTexts As Variant titlesAndTexts = Array( _ Array("Начало эры космонавтики", "4 октября 1957 года – запуск первого искусственного спутника Земли, Спутник-1."), _ Array("Первый человек в космосе", "12 апреля 1961 года – Юрий Гагарин становится первым космонавтом."), _ Array("Выход человека в открытый космос", "18 марта 1965 года – Алексей Леонов совершает первый выход в открытый космос."), _ Array("Луна и дальнейший исследования", "20 июля 1969 года – первая высадка человека на Луну, миссия «Аполлон-11»."), _ Array("Космические станции", "С 1971 года начинается эра космических станций."), _ Array("Шаттлы и reusable технологии", "Первый полёт космического шаттла в 1981 году."), _ Array("Международная космическая станция", "С 1998 года начало сборки МКС."), _ Array("Коммерческая космонавтика", "С начала XXI века развитие частных космических компаний."), _ Array("Марс и интерпланетные миссии", "Развитие миссий по исследованию Марса и других планет."), _ Array("Новые технологии и будущее", "Разработки в области космических технологий и перспективы.") _ ) ' Создание слайдов For slideIndex = LBound(titlesAndTexts) To UBound(titlesAndTexts) Set ppSlide = ppPres.Slides.Add(slideIndex + 1, 1) ppSlide.Shapes(1).TextFrame.TextRange.Text = titlesAndTexts(slideIndex)(0) ' заголовок ppSlide.Shapes(2).TextFrame.TextRange.Text = titlesAndTexts(slideIndex)(1) ' описание Next slideIndex ' Сохранение презентации ppPres.SaveAs "История космонавтики.pptx" ppApp.Activate MsgBox "Презентация 'История космонавтики' создана и сохранена!" End Sub