eksamen v15

Option Compare Database
'denne typen hører til oppgave 3
Private Type oversikt
høyeste As Long
laveste As Long
sum As Long
antallsvar As Long
End Type


Private Sub btn1a_Click()
Dim teller As Long
Dim resultat As String
For i = 1 To 100
    resultat = resultat & i & ", "
Next i
MsgBox (resultat)
End Sub

Private Sub btn1b_Click()
Dim teller As Long
Dim resultat As String
For i = 100 To 1 Step -1
    If i = 1 Then 'if-setning kun for å få pent resultat
        resultat = resultat & i & "." 'legger punktum fremfor komma på siste tall
    Else
        resultat = resultat & i & ", "
    End If
Next i
MsgBox (resultat)
End Sub

Private Sub btn1c_Click()
'Alternativ 1:
'For i = 1 To 100 Step 2
'   resultat = resultat & i & ", "
'Next i
For i = 1 To 100
    resultat = resultat & i & ", "
    i = i + 1
Next i
MsgBox (resultat)
End Sub

Private Sub btn1d_Click()
Dim j As Long
Dim kvadrattall(1 To 11) As Long
Dim funnet As Boolean

For i = 1 To 10 'legger inn kvadrattall opp til 100
        kvadrattall(i) = i * i
Next i

For i = 1 To 100 'looper fra 1 til 100
    funnet = False
    For j = LBound(kvadrattall) To UBound(kvadrattall) 'looper gjennom kvadrattallene
        If i = kvadrattall(j) Then
            funnet = True
        End If
    Next j

    If funnet = False Then 'om i ikke tilsvarer kvadrattall, lagres denne i resultat
        resultat = resultat & i & ", "
    End If
Next i
MsgBox (resultat)

End Sub

Private Sub btn2_Click()
Dim stdset As DAO.Recordset
Dim strsql As String
Dim fnr As Long
Dim filsti As String
Dim linje As String
Dim artnr As String
Dim ant As Long

strsql = "SELECT * FROM tblLageroversikt"
Set stdset = CurrentDb.OpenRecordset(strsql)
fnr = FreeFile
filsti = "C:\vba\tilvekst.txt" 'denne må tilsvare filens lokasjon

Open filsti For Input As #fnr
While Not EOF(fnr)
    Line Input #fnr, linje
            artnr = Mid(linje, 1, 5) 'henter fem første tegn, tilsvarer artikkelnr
            ant = Mid(linje, 7, Len(linje)) 'henter alt fra tegn 7 og utover, dette blir sum og eventuelle fortegn
            'antar at alle artikler i tilvekst.txt eksisterer i tabellen
            strsql = "SELECT * FROM tblLageroversikt WHERE artikkelid = '" & artnr & "'"
            Set stdset = CurrentDb.OpenRecordset(strsql)

            If (stdset("antall").Value + ant) > 0 Then 'om eksisterende antall og det som hentes fra tekstfil er høyere enn 0 oppdateres tabell
                strsql = "UPDATE tblLageroversikt SET antall = " & stdset("antall").Value + ant & _
                " WHERE artikkelid = '" & artnr & "'"
                CurrentDb.Execute (strsql)
            Else 'om ikke settes denne til null
            'antas at lagerstatus ikke skal oppdateres dersom antall negativt. Setter lagerstatus til null.
                MsgBox ("Artikkelnr. " & artnr & " vil få lagerstatus lavere enn null. Settes til null")
                strsql = "UPDATE tblLageroversikt SET antall = 0 WHERE artikkelid = '" & artnr & "'"
                CurrentDb.Execute (strsql)
            End If
Wend

End Sub



Private Sub btn3_Click()
Dim strsql As String
Dim i As Long
Dim stdset As DAO.Recordset
Dim svaroversikt(1 To 4) As oversikt
Dim resultat As String

For i = 1 To 4 'Antar at høyeste mulige score er 6
    svaroversikt(i).laveste = 6
Next i

strsql = "SELECT * FROM svar"
Set stdset = CurrentDb.OpenRecordset(strsql)

Do While Not stdset.EOF 'looper tabellen med svar
    i = stdset("SpørsmålNr").Value 'lagrer spørsmålets id
    If stdset("svar").Value > svaroversikt(i).høyeste Then 'sjekker om nåværende svar er høyere enn det foreløpige høyeste
        svaroversikt(i).høyeste = stdset("svar").Value
    End If
    If stdset("svar").Value < svaroversikt(i).laveste Then 'sjekker om nåværende svar er lavere enn det foreløpig laveste
        If Not stdset("svar").Value = 0 Then 'er det det, sjekker vi at det ikke er null
            svaroversikt(i).laveste = stdset("svar").Value
        End If
    End If

    svaroversikt(i).sum = svaroversikt(i).sum + stdset("svar").Value 'summerer summen av svar

    'dropper å summere svaret 0, da disse skulle ignoreres
    'dette kunne vært gjort via SQL, SELECT * FROM svar WHERE Svar BETWEEN 1 AND 6, deretter lagret RecordCount
    'unødvendig, siden vi uansett looper hele tabellen og kan lagre antall samtidig som dette
    If Not stdset("svar").Value = 0 Then
        svaroversikt(i).antallsvar = svaroversikt(i).antallsvar + 1 'lagrer antall besvarelser
    End If
    stdset.MoveNext
Loop

For i = 1 To 4
    resultat = resultat & "Spørsmål" & i & ": " & vbCrLf & _
    "Høyeste svar: " & svaroversikt(i).høyeste & vbCrLf & _
    "Laveste svar: " & svaroversikt(i).laveste & vbCrLf & _
    "Gjennomsnitt: " & (svaroversikt(i).sum / svaroversikt(i).antallsvar) & vbCrLf & vbCrLf
Next i
MsgBox (resultat)
End Sub

Private Sub btn4_Click()
Dim tekst, tegn, resultat As String
Dim antOrd, antSetn, antTegn As Long
tekst = Me.txt4.Value

For i = 1 To Len(tekst)
tegn = Mid(tekst, i, 1)

Select Case tegn
    Case " "
        antOrd = antOrd + 1
    Case "!"
        antSetn = antSetn + 1
        antTegn = antTegn + 1
    Case "."
        antSetn = antSetn + 1
        antTegn = antTegn + 1
    Case "?"
        antSetn = antSetn + 1
        antTegn = antTegn + 1
    Case Else
        antTegn = antTegn + 1
    End Select
Next i
resultat = "Antall tegn: " & antTegn & vbCrLf & _
"Antall ord: " & antOrd & vbCrLf & _
"Antall setninger: " & antSetn & vbCrLf

MsgBox (resultat)
End Sub