Chcete sledovať denný príjem energie v strave? Zostavte si
program v Exceli!
Natypujte do jednotlivých hárkov v Exceli energetickú hodnotu
potravín, ako aj obsah bielkovín, uhlohydrátov a tukov. Hárky pomenujte
podľa druhu potravín, napr.:
Obr.1 ilustruje zápis potrebných parametrov v jednotlivých
hárkoch. Všetky hodnoty platia na 100 g potraviny. Ak máme túto
sysifovskú prácu za sebou, vložíme v editore Visual Basic-u modul
a do modulu zapíšeme nasledujúci program (všimnime si, že premenná
po je deklarovaná pomocou kľúčového slova
public na začiatku
modulu a to znamená, že je prístupná zo všetkých procedúr a vo
všetkých moduloch, teda v celom projekte.
Public po As Integer
Sub Start()
On Error GoTo kon
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
kon:
Application.ScreenUpdating = False
Dim m As Integer, k As Integer
m = 50
For k = 2 To m
' Zmaže predcházajúce zápisy na hárku
Cells(k, 1) = ""
Cells(k, 2) = ""
Cells(k, 3) = ""
Next k
For k = 3 To m
' v bunke E2, F2, G2, H2 ponechá vzorec!
Cells(k, 5) = ""
Cells(k, 6) = ""
Cells(k, 7) = ""
Cells(k, 8) = ""
Next k
UserForm1.Show
End Sub
Potom vložme formulár (UserForm) ktorý je zobrazený na Obr.2 a do
neho vložíme desať zoznamov (ListBox). Do ListBoxov necháme zapísať
údaje, prostredníctvom okna
vlastnosti (properties).
Časť okna
vlastnosti pre
ListBox1 je zobrazená v okne
na Obr. 3. Keďže základné údaje sme zapísali do jednotlivých
hárkov (listov), všimnite si, že v okne vlastnosti treba zapísať
zdroj údajov, najprv názov hárku (listu) excelu potom výkričník a napokon oblasť:
RowSource Mäso!a2:e25
V ListBox-e máme 5 stĺpcov:
názov potraviny
počet kCal na 100 g
obsah bielkovín v gramoch
obsah tukov v gramoch
množstvo uhlohydrátov v gramoch
takže je treba zapísať do rubriky ColumnCount
(počet stĺpcov) :5.
Keď chceme mať aj nadpisy stĺpcov, zapíšeme pre položku
ColumnHeads:
True. Ak chceme zvoliť viac položiek
z jedneho druhu potravín, zadáme v položke MultiSelect:
1fm-MultiSelectMulti
Napokon pre položku ListStyle zadáme:
1fm-ListStyleOption, vtedy sa
objavia pred menom položky CheckBoxy,
do ktorých klikneme, ak chceme danú položku vybrať.
Ešte treba zapísať nasledujúce podprogramy, ktoré vložíme do
UserForm:
Sub CommandButton3_Click()
Sub CommandButton4_Click()
Tieto, pretože by sa článok neúmerne predĺžil, tu neuvádzam, ale sa
nachádzajú v súbore Kalorie.zip.
Do hárku Výber je treba vložiť nasledujúce makrá:
Private Sub Začiatok_Click()
' vložíme do hárku Výber
Application.ScreenUpdating = False
Call Start
End Sub
Sub Súčet_Click()
' vložíme do hárku Výber
Application.ScreenUpdating = False
' Spočíta KiloCalórie, bielkoviny, tuky a uhlohydráty
Dim k As Integer
' Do nasledujúcich premenných
' sa postupne vložia súčty
ss = 0# 'kCal
ss1 = 0# 'bielkoviny [g]
ss2 = 0# 'tuky [g]
ss3 = 0# 'uhlohydráty [g]
Range("B1").Select
ActiveCell.CurrentRegion.Select
pr = Selection.Areas(1).Rows.Count
' pr je počet zvolených potravín
Set SourceRange = Worksheets(1).Range(Cells(2, 5), Cells(2, 5))
' v riadku 2 stĺpca 5,6,7 a 8 v hárku Výber sú
' zadané vzorce (výpočet kCal, množstva bielkovín,
' tukov a uhlohydrátov
Set fillRange = Worksheets(1).Range(Cells(2, 5), Cells(pr, 5))
SourceRange.AutoFill Destination:=fillRange
Set SourceRange = Worksheets(1).Range(Cells(2, 6), Cells(2, 6))
Set fillRange = Worksheets(1).Range(Cells(2, 6), Cells(pr, 6))
SourceRange.AutoFill Destination:=fillRange
Set SourceRange = Worksheets(1).Range(Cells(2, 7), Cells(2, 7))
Set fillRange = Worksheets(1).Range(Cells(2, 7), Cells(pr, 7))
SourceRange.AutoFill Destination:=fillRange
Set SourceRange = Worksheets(1).Range(Cells(2, 8), Cells(2, 8))
Set fillRange = Worksheets(1).Range(Cells(2, 8), Cells(pr, 8))
SourceRange.AutoFill Destination:=fillRange
For k = 2 To pr
ss = ss + Cells(k, 5)
ss1 = ss1 + Cells(k, 6)
ss2 = ss2 + Cells(k, 7)
ss3 = ss3 + Cells(k, 8)
Next k
Range(Cells(2, 5), Cells(30, 8)).Select
Selection.NumberFormat = "0.0"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.ColorIndex = xlAutomatic
End With
po = pr + 1 ' tu nadobúda premenná
' po hodnotu, ktorá bude potrebná pri
' zostrojení koláčového grafu
Cells(po, 5).Value = ss
Cells(po, 6).Value = ss1
Cells(po, 7).Value = ss2
Cells(po, 8).Value = ss3
Range(Cells(po, 5), Cells(po, 8)).Select
With Selection.Font
.Name = "Arial"
.Size = 16
End With
End Sub
Sub Grf_Click()
' vložíme do hárku Výber
pa = po - 1
Dim myUnion As Range
Application.ScreenUpdating = False
Worksheets(1).Activate
Set myUnion = Union(Cells(1, 6), _
Cells(1, 7), Cells(1, 8), Cells(po, 6), _
Cells(po, 7), Cells(po, 8))
myUnion.Select
adr = myUnion.Address
Charts.Add
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData Source:=Sheets("Výber").Range(adr), _
PlotBy:=xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:="Výber"
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowPercent
Worksheets(1).Activate
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Interior
.ColorIndex = 3
.PatternColorIndex = 1
.Pattern = 1
End With
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Tučné"
.Size = 14
End With
ActiveChart.Legend.Font.Size = 10
With Selection.Font
.Name = "Arial"
.FontStyle = "Tučné"
.Size = 10
End With
With ActiveChart
.PlotArea.Interior.ColorIndex = 55
End With
ActiveChart.ChartArea.Select
With Selection.Interior
.ColorIndex = 48
.PatternColorIndex = 1
.Pattern = 1
End With
With ThisWorksheet
Worksheets(1).ChartObjects(1).Width = 245
Worksheets(1).ChartObjects(1).Height = 182
Worksheets(1).ChartObjects(1).Top = 55
Worksheets(1).ChartObjects(1).Left = 454
End With
ActiveChart.Location Where:=xlLocationAsObject, Name:="Výber"
Windows("Kalorie.xls").Activate
End Sub
Na obr. 4 je príklad výbratých položiek z ListBoxov, ktoré sa zobrazia
ak klikneme na tlačidlo Štart, ktoré je na liste Výber (obr. 6) a
potom na formulári vyberáme a nakoniec klikneme na tlačidlo Zapíš
vybrané položky a vzápätí na tlačidlo Koniec zápisu. Ďalej
zapíšeme v stĺpci C množstvo v gramoch. Klikneme na tlačidlo
Spolu (obr. 5) a dostávame spočítané hodnoty energie a ostatných
položiek pre vybrané potraviny. Napokon si môžeme nechať automaticky
zobraziť aj koláčový graf zobrazujúci percentuálny podiel bielkovín,
tukov a uhlohydrátov.
Niektoré vlastnosti tlačidla príkazu Štart vidíme na obr.7
Všimnite si, že sme tlačidlá premenovali, prvé na
Začiatok a druhé na
Grf.
Môžete si stiahnúť,súbor:Kalorie.zipveľkosť:33 kB
Príklady boli vypracované v Excel 2000 pod OS Windows XP
