Need a unique gift idea?
A Pastebin account makes a great Christmas gift
SHARE
TWEET

eksamen v15

a guest Nov 24th, 2016 215 Never
Upgrade to PRO!
ENDING IN00days00hours00mins00secs
 
  1. Option Compare Database
  2. 'denne typen hører til oppgave 3
  3. Private Type oversikt
  4. høyeste As Long
  5. laveste As Long
  6. sum As Long
  7. antallsvar As Long
  8. End Type
  9.  
  10.  
  11. Private Sub btn1a_Click()
  12. Dim teller As Long
  13. Dim resultat As String
  14. For i = 1 To 100
  15.     resultat = resultat & i & ", "
  16. Next i
  17. MsgBox (resultat)
  18. End Sub
  19.  
  20. Private Sub btn1b_Click()
  21. Dim teller As Long
  22. Dim resultat As String
  23. For i = 100 To 1 Step -1
  24.     If i = 1 Then 'if-setning kun for å få pent resultat
  25.        resultat = resultat & i & "." 'legger punktum fremfor komma på siste tall
  26.    Else
  27.         resultat = resultat & i & ", "
  28.     End If
  29. Next i
  30. MsgBox (resultat)
  31. End Sub
  32.  
  33. Private Sub btn1c_Click()
  34. 'Alternativ 1:
  35. 'For i = 1 To 100 Step 2
  36. '   resultat = resultat & i & ", "
  37. 'Next i
  38. For i = 1 To 100
  39.     resultat = resultat & i & ", "
  40.     i = i + 1
  41. Next i
  42. MsgBox (resultat)
  43. End Sub
  44.  
  45. Private Sub btn1d_Click()
  46. Dim j As Long
  47. Dim kvadrattall(1 To 11) As Long
  48. Dim funnet As Boolean
  49.  
  50. For i = 1 To 10 'legger inn kvadrattall opp til 100
  51.        kvadrattall(i) = i * i
  52. Next i
  53.  
  54. For i = 1 To 100 'looper fra 1 til 100
  55.    funnet = False
  56.     For j = LBound(kvadrattall) To UBound(kvadrattall) 'looper gjennom kvadrattallene
  57.        If i = kvadrattall(j) Then
  58.             funnet = True
  59.         End If
  60.     Next j
  61.    
  62.     If funnet = False Then 'om i ikke tilsvarer kvadrattall, lagres denne i resultat
  63.        resultat = resultat & i & ", "
  64.     End If
  65. Next i
  66. MsgBox (resultat)
  67.  
  68. End Sub
  69.  
  70. Private Sub btn2_Click()
  71. Dim stdset As DAO.Recordset
  72. Dim strsql As String
  73. Dim fnr As Long
  74. Dim filsti As String
  75. Dim linje As String
  76. Dim artnr As String
  77. Dim ant As Long
  78.  
  79. strsql = "SELECT * FROM tblLageroversikt"
  80. Set stdset = CurrentDb.OpenRecordset(strsql)
  81. fnr = FreeFile
  82. filsti = "C:\vba\tilvekst.txt" 'denne må tilsvare filens lokasjon
  83.  
  84. Open filsti For Input As #fnr
  85. While Not EOF(fnr)
  86.     Line Input #fnr, linje
  87.             artnr = Mid(linje, 1, 5) 'henter fem første tegn, tilsvarer artikkelnr
  88.            ant = Mid(linje, 7, Len(linje)) 'henter alt fra tegn 7 og utover, dette blir sum og eventuelle fortegn
  89.            'antar at alle artikler i tilvekst.txt eksisterer i tabellen
  90.            strsql = "SELECT * FROM tblLageroversikt WHERE artikkelid = '" & artnr & "'"
  91.             Set stdset = CurrentDb.OpenRecordset(strsql)
  92.            
  93.             If (stdset("antall").Value + ant) > 0 Then 'om eksisterende antall og det som hentes fra tekstfil er høyere enn 0 oppdateres tabell
  94.                strsql = "UPDATE tblLageroversikt SET antall = " & stdset("antall").Value + ant & _
  95.                 " WHERE artikkelid = '" & artnr & "'"
  96.                 CurrentDb.Execute (strsql)
  97.             Else 'om ikke settes denne til null
  98.            'antas at lagerstatus ikke skal oppdateres dersom antall negativt. Setter lagerstatus til null.
  99.                MsgBox ("Artikkelnr. " & artnr & " vil få lagerstatus lavere enn null. Settes til null")
  100.                 strsql = "UPDATE tblLageroversikt SET antall = 0 WHERE artikkelid = '" & artnr & "'"
  101.                 CurrentDb.Execute (strsql)
  102.             End If
  103. Wend
  104.  
  105. End Sub
  106.  
  107.  
  108.  
  109. Private Sub btn3_Click()
  110. Dim strsql As String
  111. Dim i As Long
  112. Dim stdset As DAO.Recordset
  113. Dim svaroversikt(1 To 4) As oversikt
  114. Dim resultat As String
  115.  
  116. For i = 1 To 4 'Antar at høyeste mulige score er 6
  117.    svaroversikt(i).laveste = 6
  118. Next i
  119.  
  120. strsql = "SELECT * FROM svar"
  121. Set stdset = CurrentDb.OpenRecordset(strsql)
  122.  
  123. Do While Not stdset.EOF 'looper tabellen med svar
  124.    i = stdset("SpørsmålNr").Value 'lagrer spørsmålets id
  125.    If stdset("svar").Value > svaroversikt(i).høyeste Then 'sjekker om nåværende svar er høyere enn det foreløpige høyeste
  126.        svaroversikt(i).høyeste = stdset("svar").Value
  127.     End If
  128.     If stdset("svar").Value < svaroversikt(i).laveste Then 'sjekker om nåværende svar er lavere enn det foreløpig laveste
  129.        If Not stdset("svar").Value = 0 Then 'er det det, sjekker vi at det ikke er null
  130.            svaroversikt(i).laveste = stdset("svar").Value
  131.         End If
  132.     End If
  133.    
  134.     svaroversikt(i).sum = svaroversikt(i).sum + stdset("svar").Value 'summerer summen av svar
  135.    
  136.     'dropper å summere svaret 0, da disse skulle ignoreres
  137.    'dette kunne vært gjort via SQL, SELECT * FROM svar WHERE Svar BETWEEN 1 AND 6, deretter lagret RecordCount
  138.    'unødvendig, siden vi uansett looper hele tabellen og kan lagre antall samtidig som dette
  139.    If Not stdset("svar").Value = 0 Then
  140.         svaroversikt(i).antallsvar = svaroversikt(i).antallsvar + 1 'lagrer antall besvarelser
  141.    End If
  142.     stdset.MoveNext
  143. Loop
  144.  
  145. For i = 1 To 4
  146.     resultat = resultat & "Spørsmål" & i & ": " & vbCrLf & _
  147.     "Høyeste svar: " & svaroversikt(i).høyeste & vbCrLf & _
  148.     "Laveste svar: " & svaroversikt(i).laveste & vbCrLf & _
  149.     "Gjennomsnitt: " & (svaroversikt(i).sum / svaroversikt(i).antallsvar) & vbCrLf & vbCrLf
  150. Next i
  151. MsgBox (resultat)
  152. End Sub
  153.  
  154. Private Sub btn4_Click()
  155. Dim tekst, tegn, resultat As String
  156. Dim antOrd, antSetn, antTegn As Long
  157. tekst = Me.txt4.Value
  158.  
  159. For i = 1 To Len(tekst)
  160. tegn = Mid(tekst, i, 1)
  161.  
  162. Select Case tegn
  163.     Case " "
  164.         antOrd = antOrd + 1
  165.     Case "!"
  166.         antSetn = antSetn + 1
  167.         antTegn = antTegn + 1
  168.     Case "."
  169.         antSetn = antSetn + 1
  170.         antTegn = antTegn + 1
  171.     Case "?"
  172.         antSetn = antSetn + 1
  173.         antTegn = antTegn + 1
  174.     Case Else
  175.         antTegn = antTegn + 1
  176.     End Select
  177. Next i
  178. resultat = "Antall tegn: " & antTegn & vbCrLf & _
  179. "Antall ord: " & antOrd & vbCrLf & _
  180. "Antall setninger: " & antSetn & vbCrLf
  181.  
  182. MsgBox (resultat)
  183. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top