Зараз обговорюють

"Тобто є ряд завдань, які взагалі без рекурсії не наважуються."  - це як розуміти? Перефразуй, будь ласка. 

виправив, йшлося про те що деякі завдання можна вирішити лише при використанні рекурсії

Спасибі дуже корисна стаття

А ще щось планується подібного найближчим часом?


Дякую за підтримку, радий що Вам сподобалось!

Так маю вже майже дороблений проект по управлінні Audio файлом, на заміну стандартним клавішам управління HTML5, але ще не встиг відтестувати програвання файлів з інтернету, поки лише локально працює

Надіюсь найближчим часом дороблю й закину

Рахунки

donatuadonatua.com
bitcoin1F5HRGroUtEQW9HBNbeew8iKh5KQ8vJxzw

Зворотній зв'язок

Для покращення роботи сайту надсилайте свої зауваження:
mailЗауваження
mailПропозиція

Статистика

UkrNET - поисково-информационный ресурс

VBA : Таємний Миколай (Secret Santa)

У грудні до нас приходить найчарівніше свято - День Святого Миколая. Це св'ято радості, добра. Всі з нетерпінням, заглядаючи під подушку, сподіваються на самий приємний і довгоочікуваний сюрприз.

Багато людей влаштовує на роботі таємного Миколая, тож представляємо Вам спосіб чесного розподілу.

Підготовка шаблону Outlook

santa_template

Для шаблону використаємо дане зображення як фон.

Тепер необхідно створити нове повідомлення в Oulook та додати бажаний текст і відформатувати все за бажанням. Наприклад ось так:

santa_letter

В поле з ім'ям користувача потім буде підставлятись особа якій людина приготує подарунок.

Коли готовий лист зберігаємо його як шаблон в форматі .otf

Таблиця в Excel

Для вхідних даних нам знадобиться 2 стовпці даних:

Users NameUsers Email
Користувач 1Email 1
........
Користувач nEmail n

Як мінімум необхідно 2 записи, щоб людина не дарувала сама собі подарунок :-)

Код макросу

Глобальні значення, що будуть використовуватись в різних частинах:

Const lang = "UA" ' в іншому випадку буде надіслано текст англійською '
Const limit = "150 UAH" ' сума ліміту на покупку подарунку '
Private messageText As String ' текст який буде виведено після завершення рооти макросу '
Private subjectText As String ' текст для теми листа '
Private template As String ' назва шаблону для відправки ' 

Основний код:

Sub HoHoHo()
Dim sh As Worksheet, dataRange As Range
Dim maxRow As Long, i As Long, curIndex As Long
Dim freeIndexList As New Collection, victimsArr() As String
    Set sh = ThisWorkbook.Sheets("List")
    If sh.Range("A3") <> 0 Then maxRow = sh.Range("A2").End(xlDown).Row Else MsgBox "Необхідно мінімум 2 особи!", vbCritical + vbOKOnly, "": Exit Sub
    ReDim victimsArr(2 To maxRow)
    Set dataRange = Range(sh.Range("A2"), sh.Range("B" & maxRow))
    Call ChooseLang
again:
	' наповнення переліку доступних значень для випадкового розподілу '
    For i = 2 To maxRow
        freeIndexList.Add (i)
    Next i
	' для кожної особи вибираємо особу якій буде даруватись подарунок '
    For i = 2 To maxRow
chooseIndex:
        curIndex = (freeIndexList.Count - 1) * Rnd + 1 ' вибір випадкового значення із доступного переліку '
        If dataRange(i - 1, 1) = dataRange(freeIndexList(curIndex) - 1, 1) Then If i = maxRow Then GoTo again Else GoTo chooseIndex ' правило для заборони випадків коли даруєш сам собі подарунок '
        victimsArr(i) = dataRange(freeIndexList(curIndex) - 1, 1) ' масив осіб яким будуть даруватись подарунки відповідним i-м працівником '
        freeIndexList.Remove (curIndex) ' якщо людину обрано забираємо її із доступного переліку для вибору '
    Next i
	' надсилання повідомлення визначеному переліку людей '
    For i = 2 To maxRow
        Call SendLetter(victimsArr(i), dataRange(i - 1, 2))
    Next i
    MsgBox messageText, vbInformation + vbOKOnly, ""
End Sub 

Функція для відправки повідомлення через Outlook

Private Function SendLetter(userName As String, userMail As String)
Dim OutApp As Object, OutMail As Object, deleteFolder As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    On Error GoTo cleanup
    Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.path & "∖" & template) ' створення повідомлення на основі збереженого шаблону (повинен бути в одній теці із excel файлом) '
    On Error Resume Next
    With OutMail
        .To = userMail
        .Subject = subjectText
        .htmlBody = Replace(Replace(OutMail.htmlBody, "username", userName), "limitsum", limit) ' заміна значень на необхідні нам '
        .DeleteAfterSubmit = True ' видаляє повідомлення образу після надсилання в теку Видалені '
        .Send
    End With
    Set deleteFolder = OutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
	' видалення повідомлення із теки Видалені, щоб все було чесно'
    For i = deleteFolder.Items.Count To 1 Step -1
        If deleteFolder.Items.Item(i).Subject = subjectText Then deleteFolder.Items.Item(i).Delete: Exit For
    Next i
    Set OutMail = Nothing
cleanup:
    Set OutApp = Nothing
End Function 

Процедура для заповнення даних відносно обраної мови:

Private Sub ChooseLang()
    If LCase(lang) = "ua" Then
        subjectText = "Таємний Миколайко"
        template = "UA.oft"
        messageText = "Очікуйте на Миколая!"
    Else
        subjectText = "Secret Santa"
        template = "EN.oft"
        messageText = "Wait for Santa!"
    End If
End Sub 

Завантажити файли

Завантажити з

В архіві міститься Excel файл із макросом та 2 шаблони повідомлень українською та англійською мовою.


view916like0dislike0 avatard_l4w clock 2017-11-29 00:08

Коментарі:



Для даної статті відсутні коментарі

Про нас

"Programmers World" розроблено з метою полегшення в освоєнні навичок програмування, та поширення матеріалів з сфери ІТ Українською мовою.

Кожен бажаючий може безкоштовно користуватися ресурсами сайту, щоб:

- Вивчати теоретичні аспекти мов програмування

- Переглядати практичне застосування теорії при виконанні різних міні проектів з відкритим кодом

- Розміщати свої завдання на форумі для допомоги в їх реалізації, або готового коду який може бути корисний іншим користувачам

- Спілкуватись з іншими користувачами та обмінюватись досвідом

Сайт функціонує на безопланій основі та ентузіазмі розробника, якщо Ви бажаєте долучитись до розвитку даного проекту то можете пожертвувати кошти на рахунки розміщені в блоці "Допомога сайту".

Сайт

Зареєстровані користувачі можуть скористатися системою діалогів, в профілі користувача, для отримання потрібної інформації. Написати!

Також Ви можете використати форми відправки Зауважень та Пропозицій.


Електронна пошта

Ви можете звертатись на нашу поштову скриньку site.programmersworld@gmail.com

www.000webhost.com