1
Sub CreatePersonalFinancePresentation()
2
 
3
    Dim pptApp As Object
4
    Dim pptPres As Object
5
    Dim pptSlide As Object
6
 
7
    ' Создаем или получаем объект PowerPoint
8
    On Error Resume Next
9
    Set pptApp = GetObject(, "PowerPoint.Application")
10
    On Error GoTo 0
11
 
12
    If pptApp Is Nothing Then
13
        Set pptApp = CreateObject("PowerPoint.Application")
14
    End If
15
 
16
    pptApp.Visible = True
17
 
18
    ' Создаем новую презентацию
19
    Set pptPres = pptApp.Presentations.Add
20
 
21
    ' --- Слайд 1: Титульный ---
22
    Set pptSlide = pptPres.Slides.Add(1, 1) ' ppLayoutTitle
23
    With pptSlide
24
        .Shapes(1).TextFrame.TextRange.Text = "Управление личными финансами: Мой опыт"
25
        .Shapes(2).TextFrame.TextRange.Text = "Ваше Имя" & vbCrLf & "Дата"
26
    End With
27
 
28
    ' --- Слайд 2: Введение ---
29
    Set pptSlide = pptPres.Slides.Add(2, 2) ' ppLayoutTitleAndContent
30
    With pptSlide
31
        .Shapes(1).TextFrame.TextRange.Text = "Введение"
32
        .Shapes(2).TextFrame.TextRange.Text = _
33
            "• Почему важно управлять личными финансами" & vbCrLf & _
34
            "• Кратко о моем финансовом пути" & vbCrLf & _
35
            "• Цели презентации"
36
    End With
37
 
38
    ' --- Слайд 3: Анализ текущего состояния ---
39
    Set pptSlide = pptPres.Slides.Add(3, 2)
40
    With pptSlide
41
        .Shapes(1).TextFrame.TextRange.Text = "Анализ текущего финансового состояния"
42
        .Shapes(2).TextFrame.TextRange.Text = _
43
            "• Доходы и расходы" & vbCrLf & _
44
            "• Финансовые привычки" & vbCrLf & _
45
            "• Основные проблемы и вызовы"
46
    End With
47
 
48
    ' --- Слайд 4: Планирование бюджета ---
49
    Set pptSlide = pptPres.Slides.Add(4, 2)
50
    With pptSlide
51
        .Shapes(1).TextFrame.TextRange.Text = "Планирование бюджета"
52
        .Shapes(2).TextFrame.TextRange.Text = _
53
            "• Как я составляю бюджет" & vbCrLf & _
54
            "• Используемые инструменты" & vbCrLf & _
55
            "• Пример бюджета"
56
    End With
57
 
58
    ' --- Слайд 5: Учет доходов и расходов ---
59
    Set pptSlide = pptPres.Slides.Add(5, 2)
60
    With pptSlide
61
        .Shapes(1).TextFrame.TextRange.Text = "Учет доходов и расходов"
62
        .Shapes(2).TextFrame.TextRange.Text = _
63
            "• Методы учета" & vbCrLf & _
64
            "• Анализ и корректировка расходов" & vbCrLf & _
65
            "• Привычки, которые помогают экономить"
66
    End With
67
 
68
    ' --- Слайд 6: Финансовые цели ---
69
    Set pptSlide = pptPres.Slides.Add(6, 2)
70
    With pptSlide
71
        .Shapes(1).TextFrame.TextRange.Text = "Финансовые цели"
72
        .Shapes(2).TextFrame.TextRange.Text = _
73
            "• Краткосрочные цели" & vbCrLf & _
74
            "• Долгосрочные цели" & vbCrLf & _
75
            "• План достижения целей"
76
    End With
77
 
78
    ' --- Слайд 7: Инвестиции и накопления ---
79
    Set pptSlide = pptPres.Slides.Add(7, 2)
80
    With pptSlide
81
        .Shapes(1).TextFrame.TextRange.Text = "Инвестиции и накопления"
82
        .Shapes(2).TextFrame.TextRange.Text = _
83
            "• Мой опыт инвестирования" & vbCrLf & _
84
            "• Инструменты для накоплений" & vbCrLf & _
85
            "• Управление рисками"
86
    End With
87
 
88
    ' --- Слайд 8: Личные финансовые лайфхаки ---
89
    Set pptSlide = pptPres.Slides.Add(8, 2)
90
    With pptSlide
91
        .Shapes(1).TextFrame.TextRange.Text = "Личные финансовые лайфхаки"
92
        .Shapes(2).TextFrame.TextRange.Text = _
93
            "• Советы, которые мне помогли" & vbCrLf & _
94
            "• Как избежать лишних расходов" & vbCrLf & _
95
            "• Полезные приложения и сервисы"
96
    End With
97
 
98
    ' --- Слайд 9: Итоги и выводы ---
99
    Set pptSlide = pptPres.Slides.Add(9, 2)
100
    With pptSlide
101
        .Shapes(1).TextFrame.TextRange.Text = "Итоги и выводы"
102
        .Shapes(2).TextFrame.TextRange.Text = _
103
            "• Главные уроки моего опыта" & vbCrLf & _
104
            "• Что изменилось в моей жизни" & vbCrLf & _
105
            "• Рекомендации"
106
    End With
107
 
108
    ' --- Слайд 10: Спасибо за внимание ---
109
    Set pptSlide = pptPres.Slides.Add(10, 1) ' Титульный макет для простоты
110
    With pptSlide
111
        .Shapes(1).TextFrame.TextRange.Text = "Спасибо за внимание!"
112
        .Shapes(2).TextFrame.TextRange.Text = "Готов ответить на ваши вопросы."
113
    End With
114
 
115
    ' Очистка объектов
116
    Set pptSlide = Nothing
117
    Set pptPres = Nothing
118
    Set pptApp = Nothing
119
 
120
    MsgBox "Презентация успешно создана!"
121
 
122
End Sub