Zdravá výživa

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.:

Ušká hárkov

Ušká hárkov

Kalórie

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).

Formulár

Č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:
  1. názov potraviny
  2. počet kCal na 100 g
  3. obsah bielkovín v gramoch
  4. obsah tukov v gramoch
  5. 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ť.

Vlastnosti

Ešte treba zapísať nasledujúce podprogramy, ktoré vložíme do UserForm: 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.

Výber

Výsledky

Začiatok

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.

Vlastnosti

Môžete si stiahnúť,súbor:   Kalorie.zip  veľkosť:33 kB
Príklady boli vypracované v Excel 2000 pod OS Windows XP

© Klára Mrázová
Valid HTML 4.01 Transitional
Stránka je v súlade s aktuálnymi normami.