Создание оригинального поздравления женщине в Excel

Здравствуйте, друзья. С вами Андрей.
У нас необычный урок. Сегодня мы создадим анимированное поздравление для женщин. У меня это поздравление выглядит примерно вот так.
Что бы сделать такое анимированное поздравление, нам понадобится картинка с красивым цветком, желательно в формате *.png (пи эн жи), с прозрачным фоном, текст поздравления и немного времени. В описании я оставлю ссылку на несколько картинок и текстов для разных категорий женщин. Реализация может быть двух видов, даже трёх.
Вариант первый.
Вы имеете доступ к компьютеру своей дамы, например на работе или дома.
В первую очередь нужно создать макрос, который будет рисовать цветок и текст поздравления. Хорошая новость в том, что я его уже написал, и Вам нужно только изменить в нём некоторые моменты, так сказать обработать напильником. Сейчас расскажу, какие параметры можно менять в этом макросе и зачем.
Если Вы не знаете что такое макрос, то довожу до Вашего сведения - макрос, это такая программа, которую создаёт Excel, записывая Вашу работу в приложении. Потом эту программу можно вызвать и с её помощью очень быстро повторить свои действия. У нас макрос уже записан, поэтому давайте выяснять, где он живёт и как выглядит.
Перейдём во вкладку разработчик и нажмём на кнопку Visual Basic. Открылся редактор, который служит для сохранения и изменения макросов. Обычно их записывают в личную книгу макросов, тогда они доступны на любом листе, но можно сохранить и в отдельной книге, тогда они будут доступны, если этот файл открыт. Наша процедура живёт в личной книге макросов в девятом модуле и называется joy. Текст макроса находится между ключевыми словами Sub и End Sub. До этого оператора, который отвечает за обработку ошибок (On Error Resume Next), идёт объявление переменных. Переменные, это ячейки памяти, в которые можно записывать и потом использовать разные данные. Она объявляется оператором Dim, после которого пишется её имя и тип данных. Например, в строковую переменную S, я записал путь к файлу картинки. Вы можете заменить этот путь на свой. По поводу переменных, если Вы не знаете, какие данные будете использовать, или не знаете, как объявить переменную с Вашим типом данных, то применяйте переменную Variant, она сама разберётся, чего Вы в неё хотите запихнуть. И ещё, все переменные, которые объявлены в этой процедуре, будут хранить данные, только пока выполняется процедура, потом они исчезнут. В переменную SP мы записываем текст поздравления. Фразы должны быть в кавычках, соединяются между собой вот таким оператором…, а эта крякозябля служит для переноса текста на другую строку. Соответственно, данный текст Вы можете изменить на любой другой. Если поставить одиночную кавычку, то за ней можно писать комментарий. В данной процедуре комментарии зелёного цвета и написаны заглавными буквами.
Следующий кусок кода добавляет на лист картинку, устанавливает её местоположение и размер. Это тонкий момент, так как у меня разрешение экрана 1366 на 768 пикселей, скорее всего у Вас и у Вашей дамы разрешение больше, поэтому поиграйте с этим куском, и если нужно, то измените некоторые циферки. По комментариям должно быть понятно, что нужно менять. Картинка загружена и установлена, теперь её нужно скрыть. Так как она имеет нормальный вид, а у нас задача сначала показать её с эффектами, а потом постепенно сделать нормальной. Картинку скрыли, теперь нужно применить к ней эффекты.

Давайте загрузим цветок вручную и из интерфейса программы посмотрим, что я применил в коде. Активируем Excel, выделяем первую ячейку, открываем вкладку «Вставка» и нажимаем кнопку «Рисунок». Находим свою папку и нужный файл, нажимаем «Вставить». Нажимаем на нём правой кнопкой мыши и в контекстном меню выбираем «Формат рисунка». В открывшейся форме нас интересует вкладка «Свечение и сглаживание». В процедуре я установил следующие параметры:
Свечение.
Размер: 150 пунктов
Прозрачность: 70 процентов
Сглаживание.
Размер: 100 пунктов.
После появления текста я их постепенно убираю.
Можно установить другие параметры, в процедуре их не уменьшать, а увеличивать, или сначала увеличивать, потом уменьшать. Вариантов масса, и Вы уже поняли, что я выбрал самый простой - это врождённая лень. Нажимаем «закрыть». Теперь хочу показать, какой я использовал текст. Нажимаем кнопку WordArt. Появились возможные варианты. Мне понравился вот этот, Вы можете выбрать какой хотите. В комментариях к макросу написано как это сделать. По умолчанию добавляется шрифт размера 54, я его изменил на 34.

Давайте вернёмся в редактор и закончим нашу процедуру. Картинка имеет желаемый вид, соответственно теперь его можно показать. Следующей строкой мы добавили рамку текста и поместили в неё первую букву. Вот эта константа отвечает за выбор шрифта, а вот это значение указывает его размер. Далее идёт цикл, который повторяется столько раз, сколько букв в нашем поздравлении. Повторяется код, который заключён меду For и Next. В каждом повторении мы добавляем в поздравление ещё по одной букве. Далее идёт закомментированный код, возможно он Вам пригодится. Если нужно выравнивание по левому краю, то уберите перед этими строками одиночные кавычки. Оператор DoEvents передаёт на время управление операционной системе, ей тоже нужно дать поработать. Далее идёт процедура «Towait». У Вас появление текста может происходить гораздо быстрее. Увеличив время задержки, выполнение процедуры можно замедлить. Следующие закомментированные строки убирают эффекты с цветка. Если удалить перед ними одиночные кавычки, то текст и цветок будут изменяться одновременно. Последние два цикла постепенно меняют цветок к нормальному виду. В эти циклы Вы так же можете добавить процедуру «Towait» для их замедления. Что бы всё это имело вид открытки, в конце я ставлю на лист защиту от изменений. Процедура готова. Теперь нужно сделать так, что бы она стала работать на компьютере дамы.

Лично для себя я придумал так. Присваиваем процедуре сочетание клавиш Ctrl + п. Примерно за день до поздравления, установлю все эти игрушки на машину Светланы Фёдоровны. В нужный момент подойду к ней и спрошу: Светлана Фёдоровна, Вы когда-нибудь в программе Excel нажимали сочетание клавиш Ctrl + п. Она скажет - нет. А Вы попробуйте, отвечу я. В любом случае, до конца рабочего дня она это сделает. От поздравления не уйти.

Теперь расскажу, как я буду переносить код на её компьютер.
У нас есть три процедуры.
Первая: joy() Рисует поздравление.
Вторая: Towait() Замедляет выполнение.
Третья: Workbook_Open() Назначает выполнение процедуры joy от нажатия клавиш Ctrl + п
Данная процедура помещается в книгу макросов и выполняется автоматически при открытии программы Excel. Все три процедуры будут в описании к видео. Я их скопирую в текстовой файл и вместе с картинкой сохраню на флэшку. В обеденный перерыв вставлю флэшку в компьютер, скопирую папку с картинкой на диск C, открою файл с процедурами, всё выделю и скопирую в буфер обмена. Затем открою Excel, перейду на вкладку разработчик и нажму кнопку Visual Basic. Личная книга макросов находится в самом верху классификатора. Открываем папку Microsoft Excel Object, выделяем папку «Эта книга», нажимаем правую кнопку и в подменю Insert применяем команду «модуль». Добавится новый модуль, в который мы и вставим всё наше добро. Теперь разберёмся с процедурой Workbook_Open(), её место на странице книги. Выделяем всё, что находится между первой и последней строкой процедуры, нажимаем правую кнопку и копируем в буфер. Затем два раза щёлкаем папку «Эта книга». Если там нет такой процедуры, то в левом верхнем выпадающем списке выбираем Workbook, а в правом выпадающем списке выбираем Open. Будет создана процедура, внутрь которой мы вставим скопированный код. Если такая процедура уже есть, то вставляем наш код в самый конец процедуры. Для порядка можно вернуться в наш модуль и удалить процедуру открытия книги, она там не нужна. Остался самый важный момент, это нажать кнопку с изображением дискеты и сохранить изменения в личной книге макросов. Теперь можно закрыть Visual Basic и Excel. Ну и ещё один важный момент. Прежде чем идти в бой, потренируйтесь на своём компьютере, попробуйте вызывать процедуру с русской и с английской раскладкой клавиатуры.

Кстати, спонсором данного видео является программа DefSmeta. Она предназначена для определения стоимости ремонта, отделки и малоэтажного строительства. Содержит прекрасный функционал по упрощению и ускорению составления смет. И самое главное, её даже покупать не нужно, достаточно взять в аренду на сайте defsmeta.com

А мы переходим ко второму варианту. Когда Вы не имеете доступа к компьютеру своей дамы, например в командировке, или по какой то другой причине. Тогда можно прислать ей файл по E-Mail. Процедуры в нём такие же, только начинаются сразу при открытии документа и незначительно отличаются из-за того, что картинка уже на листе. Такой файл я приготовил. Вы можете скачать его и отредактировать по собственному усмотрению. Единственное условие, картинка на листе должна быть только одна. Если вставите свою, то не забудьте удалить мою. В этом способе есть один нюанс, а скорее даже два. На компьютере Вашей дамы, в Excel, должна быть установлена опция «Включать все макросы». Устанавливается следующим образом. Переходим на вкладку «разработчик» и нажимаем кнопку «безопасность макросов». В параметрах макросов выбираем самую последнюю опцию. Тогда всё будет работать. Но есть ещё одна трудность. Файл из почты открывать нельзя, его нужно сначала сохранить на диск, потом открыть не из проводника, а из программы Excel. Думаю, что ни одна дама так делать не станет. Одним словом, вариант с пересылкой очень плох. Но существует третий вариант. Если идея Вам понравилась, но нет желания или возможности заниматься макросами, то используйте готовые видеофайлы с поздравлениями, которые я сделал и ссылки разместил в описании. Можете отправить их своим дамам. И ещё одна хорошая новость. В следующем видео я покажу как подшутить над коллегой в программе Excel. Шутка выполняется без макросов, всё через интерфейс. Так что к первому апреля Вы будете готовы.

Надеюсь, что информация была полезной. Описание программы DefSmeta вы можете получить на сайте defsmeta.com Желаю всем удачи. До новых встреч на уроках по программе.

Option Explicit
Option Base 1

Sub joy()
' Сочетание клавиш: Ctrl+п ' НАЗНАЧЕНО В ПРОЦЕДУРЕ ОТКРЫТИЯ КНИГИ МАКРОСОВ
Dim i As Integer
Dim N As Integer
Dim M As Variant
Dim FL As Object
Dim TopT As Long
Dim LeftT As Long
Dim ObT As Object
Dim S As String
Dim SP As String
Dim SPCount As Long
Dim SPInCicl As String
Dim CountF As Integer
On Error Resume Next
S = "C:\FL\001.png" ' ПУТЬ К ФАЙЛУ КАРТИНКИ
If Dir(S) = "" Then Exit Sub ' ПРОВЕРКА, ЕСТЬ ЛИ ФАЙЛ КАРТИНКИ
SP = "МИЛАЯ!" & Chr(13) & "С ПРАЗДНИКОМ ВЕСНЫ!" & Chr(13) & "ТЫ НЕЖНА И ПРЕКРАСНА," & Chr(13) & "КАК ЭТОТ ЦВЕТОК!" 'ПОЗДРАВЛЕНИЕ

SPCount = Len(SP) ' ОПРЕДЕЛЯЕМ КОЛИЧЕСТВО СИМВОЛОВ ПОЗДРАВЛЕНИЯ

'ДОБАВИМ КНИГУ, УБЕРЁМ СЕТКУ, ЗАГОЛОВКИ СТРОК И СТОЛБЦОВ, А ТАК ЖЕ СДЕЛАЕМ ПРИЛОЖЕНИЕ ВО ВЕСЬ ЭКРАН
Workbooks.Add
Sheets(1).Name = "Поздравление от сердца"
Range("A1").Select
ActiveWindow.DisplayGridlines = False 'УБИРАЕМ СЕТКУ
ActiveWindow.DisplayHeadings = False 'УБИРАЕМ ЗАГОЛОВКИ СТРОК И СТОЛЮЦОВ
Application.DisplayFullScreen = True 'ДЕЛАЕМ ПРИЛОЖЕНИЕ ВО ВЕСЬ ЭКРАН ДЛЯ ПЕРЕХОДА В НОРМАЛЬНЫЙ РЕЖИМ НАЖИМАЕМ КЛАВИШУ "ESCAPE"

Set FL = ActiveSheet.Pictures.Insert(S) 'ЗАГРУЖАЕМ КАРТИНКУ
FL.Placement = xlMoveAndSize
FL.PrintObject = True
FL.ShapeRange.LockAspectRatio = msoTrue 'БЛОКИРОВКА СООТНОШЕНИЯ СТОРОН
FL.Top = Cells(1, 1).Top + Application.Height / 5 ' УСТАНАВЛИВАЕМ ВЕРХНИЙ КРАЙ КАРТИНКИ
FL.Left = Cells(1, 1).Left + Application.Width / 6 ' УСТАНАВЛИВАЕМ ЛЕВЫЙ КРАЙ КАРТИНКИ
FL.Height = Application.Height / 2 ' УСТАНАВЛИВАЕМ ВЫСОТУ КАРТИНКИ

LeftT = FL.Left + FL.Width * 1.6 ' УСТАНАВЛИВАЕМ ЛЕВЫЙ КРАЙ НАДПИСИ
TopT = FL.Top + FL.Top / 4 ' УСТАНАВЛИВАЕМ ВЕРХНИЙ КРАЙ НАДПИСИ
FL.ShapeRange.Visible = False 'ДЕЛАЕМ КАРТИНКУ НЕВИДИМОЙ

'ЭФФЕКТ СВЕЧЕНИЕ И СГЛАЖИВАНИЕ
With FL.ShapeRange.Glow
.Color.ObjectThemeColor = msoThemeColorAccent1
.Color.TintAndShade = 0
.Color.Brightness = 0
.Transparency = 0.7 'ПРОЗОАЧНОСТЬ ОТ 0 до 100 СТО - ПРОЗРАЧНОЕ, НОЛЬ - СИНЕЕ
.Radius = 150 ' РАЗМЕР СВЕЧЕНИЯ 150 МАКСИМУМ
End With
FL.ShapeRange.SoftEdge.Radius = 100
FL.ShapeRange.Visible = True ' ПОКАЗЫВАЕМ КАРТИНКУ С ЭФФЕКТОМ
DoEvents

'СТАРТОВЫЙ ЦВЕТОК НАРИСОВАН.
'РИСУЕМ ВСЮ НАДПИСЬ ПО ОДНОЙ БУКВЕ. msoTextEffect23, msoTextEffect25 - РАЗНЫЙ ШРИФТ И ЦВЕТ

Set ObT = ActiveSheet.Shapes.AddTextEffect(msoTextEffect23, Left(SP, 1), "+mn-lt", 34, msoTrue, msoFalse, LeftT, TopT)

SPInCicl = Left(SP, 1) 'ПЕРВАЯ БУКВА ПОЗДРАВЛЕНИЯ
CountF = 100
For i = 2 To SPCount
SPInCicl = SPInCicl & Mid(SP, i, 1) 'ДОБАВЛЯЕМ ПО ОДНОЙ БУКВЕ
ObT.TextFrame2.TextRange.Characters.Text = SPInCicl

' ЕСЛИ НУЖНО, УСТАНАВЛИВАЕМ ВЫРАВНИВАНИЕ ПО ЛЕВОМУ КРАЮ
N = ObT.TextFrame2.TextRange.Characters.Count
ObT.TextFrame2.TextRange.Characters(1, N).ParagraphFormat.Alignment = msoAlignLeft

DoEvents
towait 0.55, False 'ЕСЛИ СИЛЬНО БЫСТРО ИДУТ БУКВЫ, ЗАМЕДЛЯЕМ ЭТОЙ ПРОЦЕДУРОЙ

'ВМЕСТЕ С НАДПИСЬЮ, МОЖНО РИСОВАТЬ ЦВЕТОК, ПОТОМ ПРОДОЛЖИТЬ РИСОВАТЬ БЕЗ НАДПИСИ
' CountF = CountF - 1
' FL.ShapeRange.SoftEdge.Radius = CountF 'РАЗМЕР СГЛАЖИВАНИЯ ОТ 0 до 100 НОЛЬ - ЦВЕТОК БОЛЬШОЙ, 100 ЦВЕТОК МАЛЕНЬКИЙ
' DoEvents
Next

For i = CountF To 1 Step -1 'For i = 100 To 1 Step -1
FL.ShapeRange.SoftEdge.Radius = i 'РАЗМЕР СГЛАЖИВАНИЯ ОТ 0 до 100 НОЛЬ - ЦВЕТОК БОЛЬШОЙ, 100 ЦВЕТОК МАЛЕНЬКИЙ
DoEvents 'ДАЁМ СИСТЕМЕ ПОРАБОТАТЬ
Next

For i = 70 To 100
M = i / 100
FL.ShapeRange.Glow.Transparency = M 'ПРОЗОАЧНОСТЬ
DoEvents
Next

Set FL = Nothing
Set ObT = Nothing
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub


Public Sub towait(Optional ByVal Time As Double = 0.3, Optional Locked As Boolean = False)
Dim Start As Single
Dim i As Long
Dim N As Long
On Error Resume Next
Start = Timer
Do
If Locked = False Then
DoEvents
Else
N = 0
For i = 1 To 10000
N = N + 1
Next
End If
Loop While Timer - Start < Time
End Sub


Private Sub Workbook_Open()
On Error Resume Next
'НАЗНАЧАЕТ МАКРОСУ СОЧЕТАНИЕ КЛАВИШ Ctrl + п
'ЕСЛИ ОТКРЫТ АНГЛИЙСКИЙ ЯЗЫК, ТО ПРОИСХОДИТ ОШИБКА
Err.Clear
Application.OnKey "^п", "joy"
If Err.Number <> 0 Then
Application.OnKey "^g", "joy"
End If
End Sub