Adjan AutoPro

Menu
Linkedin Youtube Instagram Envelope Tiktok Whatsapp
Leave a Comment / Excel VBA / By

Excel VBA (Special 01, Korona Statistika)

📝 Ovaj video sam posvetio trenutnom stanju koje vlada u svetu a to je Korona virus (coronavirus) tj. COVID 19.
Ali pre svega #ostanikodkuće !
U ovom tutorialu proćićemo ceo proces izrade jednog projekta u Excelu sa userform.

🔎 Linkovi korišćeni za ovaj video su:

🎬 Pogledajte naš predhodni video o Aritmetičkim operatorima https://youtu.be/oCYp9UajXsk

FORME

Form 01 – How To

Kod koji je korišćen u ovoj formi je:

' skloni top bar (definicija)
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)

' deklarisanje promenjivih
Dim bgColor As Long
Dim blueColor As Long
Dim greyColor As Long
Dim Step As Integer

' on start up
Private Sub UserForm_Initialize()
    Dim frm As Long
    wHandle = FindWindow(vbNullString, Me.Caption)
    frm = GetWindowLong(wHandle, GWL_STYLE)
    SetWindowLong wHandle, -16, 0
    DrawMenuBar wHandle
     
    bgColor = RGB(149, 101, 35)
    
    Step = 1
    
    Call savet1
    Call interface
End Sub


' Dugme sledece
Private Sub btn_Next_Click()
    Step = Step + 1
    
    Call stepSub
End Sub

' Dugme predhodno
Private Sub btn_Previous_Click()
    Step = Step - 1
    
    If Step = 0 Then
        Step = 1
    End If

    Call stepSub
End Sub

' pracenje stepova (koraka-saveta)
Sub stepSub()

    If Step = 1 Then
    Call savet1
    End If
    
    If Step = 2 Then
    Call savet2
    End If
    
    If Step = 3 Then
    Call savet3
    End If
    
    
    If Step = 4 Then
    Call savet4
    End If
    
    
    If Step > 3 Then
    btn_Next.Caption = "START"
    End If
    
    
    If Step < 4 Then
    btn_Next.Caption = "Slede" + ChrW(mojaSlova("c")) + "e"
    End If
    
    If Step = 5 Then
    Unload Me
    Statistika.Show
    End If
    

End Sub




' linkovan label
Private Sub lbl_Link_Click()
    Dim IE As Object
    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    
    IE.navigate "https://www.unicef.org/serbia/%C5%A1ta-treba-da-znate-o-korona-virusu-da-biste-za%C5%A1titili-sebe-svoju-decu-i-porodicu"
End Sub





Sub interface()

    btn_Next.Caption = "Slede" + ChrW(mojaSlova("c")) + "e"

    bgColor = RGB(149, 101, 35)
    blueColor = RGB(0, 172, 238)
    greyColor = RGB(213, 213, 213)
    
    
    HowTo.BackColor = bgColor
    
    lbl_Tacka1.ForeColor = blueColor
    lbl_Tacka2.ForeColor = greyColor
    lbl_Tacka3.ForeColor = greyColor
    lbl_Tacka4.ForeColor = greyColor
    
        
    lbl_Prelaz1.ForeColor = blueColor
    lbl_Prelaz2.ForeColor = greyColor
    lbl_Prelaz3.ForeColor = greyColor
    
End Sub



Sub savet1()

lbl_SavetTitle.Caption = "Savet 1"
lbl_SavetDetails.Caption = ChrW(mojaSlova("Ch")) + "esto perite ruke sapunom i vodom ili ih brišite vlažnim maramicama na bazi alkohola."

    lbl_Tacka1.ForeColor = blueColor
    lbl_Tacka2.ForeColor = greyColor
    lbl_Tacka3.ForeColor = greyColor
    lbl_Tacka4.ForeColor = greyColor

    lbl_Prelaz1.ForeColor = blueColor
    lbl_Prelaz2.ForeColor = greyColor
    lbl_Prelaz3.ForeColor = greyColor

    Image1.Visible = True
    Image2.Visible = False
    Image3.Visible = False
    Image4.Visible = False

End Sub


Sub savet2()

lbl_SavetTitle.Caption = "Savet 2"
lbl_SavetDetails.Caption = "Pokrijte usta i nos savijenim laktom ili maramicom, upotrebite maramicu prilikom kašlja i kijanja, a nakon toga iskorišcenu maramicu bacite u zatvorenu kantu."

    lbl_Tacka1.ForeColor = blueColor
    lbl_Tacka2.ForeColor = blueColor
    lbl_Tacka3.ForeColor = greyColor
    lbl_Tacka4.ForeColor = greyColor

    lbl_Prelaz1.ForeColor = blueColor
    lbl_Prelaz2.ForeColor = blueColor
    lbl_Prelaz3.ForeColor = greyColor

    Image1.Visible = False
    Image2.Visible = True
    Image3.Visible = False
    Image4.Visible = False

End Sub


Sub savet3()

lbl_SavetTitle.Caption = "Savet 3"
lbl_SavetDetails.Caption = "Izbegavajte bliski kontakt sa osobama koje imaju simptome prehlade ili gripa."

    lbl_Tacka1.ForeColor = blueColor
    lbl_Tacka2.ForeColor = blueColor
    lbl_Tacka3.ForeColor = blueColor
    lbl_Tacka4.ForeColor = greyColor

    lbl_Prelaz1.ForeColor = blueColor
    lbl_Prelaz2.ForeColor = blueColor
    lbl_Prelaz3.ForeColor = blueColor

    Image1.Visible = False
    Image2.Visible = False
    Image3.Visible = True
    Image4.Visible = False

End Sub



Sub savet4()

lbl_SavetTitle.Caption = "Savet 4"
lbl_SavetDetails.Caption = "Obratite se lekaru ukoliko imate povišenu temperaturu, kašljete ili otežano dišete."

    lbl_Tacka1.ForeColor = blueColor
    lbl_Tacka2.ForeColor = blueColor
    lbl_Tacka3.ForeColor = blueColor
    lbl_Tacka4.ForeColor = blueColor

    lbl_Prelaz1.ForeColor = blueColor
    lbl_Prelaz2.ForeColor = blueColor
    lbl_Prelaz3.ForeColor = blueColor

    Image1.Visible = False
    Image2.Visible = False
    Image3.Visible = False
    Image4.Visible = True

End Sub

' function za slova  (problem sa "Cesto" i "Sledece"
Public Function mojaSlova(slovo As String) As Integer

    If slovo = "Ch" Then
        mojaSlova = 268
    End If
    
    If slovo = "c" Then
        mojaSlova = 263
    End If

End Function

Forma 02 – Statistika

Kod koji je korišćen u ovoj formi je: 

' deklarisanje promenjivih
Dim rngPoGradovima As Range
Dim rngPoDanu As Range
Dim redColor As Long


' na promenu gradova
Private Sub cb_Gradovi_Change()
    lbl_Grad.Caption = cb_Gradovi.Text
    lbl_GradBroj = Application.WorksheetFunction.VLookup(cb_Gradovi.Text, Sheet3.Range("A2:B100"), 2, 0)
End Sub



' on start up
Private Sub UserForm_Initialize()

    redColor = RGB(193, 28, 34)
    
    
    Label00.BackColor = redColor
    Label01.BackColor = redColor
    Label02.BackColor = redColor
    
    lbl_Grad.BackColor = redColor
    lbl_TotalHosp.BackColor = redColor
    lbl_TotalObolelih.BackColor = redColor
    
    Set rngPoGradovima = Sheet3.Range("B2:B100")
    Set rngPoDanu = Sheet5.Range("G2:G100")
    
    ' UKUPAN BROJ OBOLELIH (suma iz zadate kolone)
    lbl_TotalHospBroj.Caption = Application.WorksheetFunction.Sum(rngPoGradovima)

    Call TotlaObolelih
    Call ChangeChart("LineChart")
    Call maxObolelih
    Call dynamicRange
    
End Sub


' Najveci broj zaraženih (pronadji najvecu vrednost iz kolone)
Sub maxObolelih()
    Dim maxNo As Integer
    maxNo = Application.WorksheetFunction.Max(rngPoDanu)
    lbl_MaxObolelih.Caption = "Najve" + ChrW(HowTo.mojaSlova("c")) + "i broj zaraženih do sada: " & maxNo & " osoba"
End Sub



' UKUPAN BROJ HOSPITALIZOVANIH (pronadji poslednji red u koloni)
Sub TotlaObolelih()
    Dim lrow As Integer
    lrow = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
    lbl_TotalObolelihBroj.Caption = Sheet5.Range("G" & lrow).Value
End Sub



Private Sub ob_Column_Click()
    Call ChangeChart("ColumnChart")
End Sub

Private Sub ob_Line_Click()
    Call ChangeChart("LineChart")
End Sub

Private Sub ob_Pie_Click()
 Call ChangeChart("PieChart")
End Sub




' promena chartova (suvanje i ucitavanje u userform)
Sub ChangeChart(ChartName As String)


    Dim CurrentChart As Chart
    Dim FName As String
    
    FName = ThisWorkbook.Path & "\temp.jpg"
    
    Set CurrentChart = ThisWorkbook.Sheets("KoronaStatistika").ChartObjects(ChartName).Chart
    
    CurrentChart.Export Filename:=FName, filtername:="jpg"
    
    Statistika.Image_Charts.Picture = LoadPicture(FName)

End Sub


' dinamicni range za gradove
Sub dynamicRange()

    Dim x As Long
    
    x = Sheet3.Range("B1000").End(xlUp).Offset(1, 0).Row - 1
    Sheet3.Range("A" & 2, "A" & x).Name = "GradoviRange"
    
End Sub

MODULI

Module 01 – Menu

Public Sub runMyApp()
    HowTo.Show
End Sub

Excel dokument kao i fotografije iz ovog videa možete preuzeti na linku ispod.

Download

🔴 Subscribe na moj YT kanal

Leave a Comment

Your email address will not be published. Required fields are marked *

Scroll to Top