Да си направим тото в Еxcel чрез VBA макрос

Кой е казал, че Microsoft Excel трябва да се използва само за изчислителни справки?

Приложението има безброй възможности, дори и с развлекателна насоченост. Такъв е и нашият пример – лотарийна игра с числата от тотото, с три вида тегления : 6 от 49, 6 от 42 и 5 от 35.

За целта създайте нова работна книга (Workbook), и изберете листа, в който ще става тегленето на произволните числа. В нашия пример сме избрали числата от играта 6 от 49, да се визуализират в областта от клетки от A2:F2.  За означаване на печелившите числа над тях сме задали заглавие “Печеливши числа от играта 6/42”. Може да форматирате клетките по Ваше желание.

В този пример сме задали:

• височина на 2-ри ред – 41;
• формат на клетките A2:F2:
  • шрифт Arial, размер 16;
  • удебелен шрифт;
  • централно подравняване в клетките.

За по-красиво визуално представяне може във всяка клетка да добавите по една сферична форма от таба Insert -> Shapes, която да бъде без запълване, но с рамка:

Следващата стъпка е да добавите изображение или да начертаете формичка, която да играе ролята на старт бутон на Вашата игра.

В клетка G5 приложете формат на шрифта: Arial, размер 15 и удебеляване. В тази клетка след изтегляне на всички числа, ще се изписва текст “Честито на печелившите!”.

По аналогичен начин направете и за числата за останалите две тегления.

В нашия пример сме ги позицонирали в области от клетки A11:F11 и A21:E21, както е показано на изображението по-долу:

Формата на шрифта в клетки G14 и G24 е както формата от клетка G5.

Може да премахнете мрежата от клетки от таб View – > премахнете отметката на Gridlines.

За да запишем макросите, които да изтеглят на произволен принцип числата за различните игри, е необходимо най-напред да отворим средата на VBA ( Visual Basic for Application), или по-просто казано – хранилището на макросите.

Отидете върху името на работния лист (Sheet). С десен клик на мишката изберете от падащия списък  “View code” :

Отваря се средата на VBA , и директно страницата с макросите валидни за Вашия работен лист. Копирайте и поставете следния код :

---

Sub Toto6Of49()

    ‘Дефиниране на променливи

    Dim LowerBound As Integer

    Dim UpperBound As Integer

    Dim RandomRange As Range

    Dim rng As Variant

    Dim RandNum As Integer

    LowerBound = 1

    UpperBound = 49

    Set RandomRange = Range(„A2:F2“)

    RandomRange.Value = „“

    Range(„G5“).Value = „“

    For Each rng In RandomRange

        RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        ‘Проследяваме дали числото фигурира само веднъж

        Do While Application.WorksheetFunction.CountIf(RandomRange, RandNum) >= 1

            RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        Loop

        rng.Value = RandNum

        Application.Wait Now + #12:00:02 AM#

    Next

    Range(„G5“).Value = “Честито на печелившите!”

End Sub

Sub Toto6Of42()

    ‘Дефиниране на променливи

    Dim LowerBound As Integer

    Dim UpperBound As Integer

    Dim RandomRange As Range

    Dim rng As Variant

    Dim RandNum As Integer

    LowerBound = 1

    UpperBound = 42

    Set RandomRange = Range(„A11:F11“)

    RandomRange.Value = „“

    Range(„G14“).Value = „“

    For Each rng In RandomRange

        RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        ‘Проследяваме дали числото фигурира само веднъж

        Do While Application.WorksheetFunction.CountIf(RandomRange, RandNum) >= 1

            RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        Loop

        rng.Value = RandNum

        Application.Wait Now + #12:00:02 AM#

    Next

    Range(„G14“).Value = “Честито на печелившите!”

End Sub

Sub Toto5Of35()

    ‘Дефиниране на променливи

    Dim LowerBound As Integer

    Dim UpperBound As Integer

    Dim RandomRange As Range

    Dim rng As Variant

    Dim RandNum As Integer

    LowerBound = 1

    UpperBound = 35

    Set RandomRange = Range(„A21:E21“)

    RandomRange.Value = „“

    Range(„G24“).Value = „“

    For Each rng In RandomRange

        RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        ‘Проследяваме дали числото фигурира само веднъж

        Do While Application.WorksheetFunction.CountIf(RandomRange, RandNum) >= 1

            RandNum = Int((UpperBound – LowerBound + 1) * Rnd + LowerBound)

        Loop

        rng.Value = RandNum

        Application.Wait Now + #12:00:02 AM#

    Next

    Range(„G24“).Value = “Честито на печелившите!”

End Sub

---

Затваряте VBA средата и сега остава да присвоим върху нашите бутони вече записаните макроси.

Изберете избраното изображение или формичка, играещо ролята на Start бутон за играта. С десен клик на мишката върху него от падащия прозорец изберете Assign Macro  и изберете макроса Sheet1.Toto6Of49. Потвърдете с бутона Ок:

По същия начин присвоете макросите и за останалите два бутона.

Сега с избор на мишката върху избран от нас бутон стартираме играта.

За да се запази файлът с въведените макроси, e задължително да бъде съхранен с подходящо разширение.

За тази цел от раздела File -> Save As – > съхранете файла с разширение Excel Macro-Enabled Workbook (*.xlsm).

Voila! Enjoy your game!

Прочетете още: КОЛЕДНА КАРТИЧКА В EXCEL

За още по-ефективна работа с VBA разгледайте и предлаганите от нас курсове .