CODES ~Matthijs

OPDRACHT GOKMACHINE

Option Explicit
Dim Poging As Integer

Sub stage(stage As Integer)
    Dim Random As Integer
    Dim Gegokt As Boolean
    Dim Nummer As Integer

    Random = Int((6 - 1 + 1) * Rnd + 1)
    Gegokt = False
    Do While Not Gegokt
        Nummer = InputBox("stage " & CStr(1) & ": Vul een getal in")
        If Nummer = Random Then
            Gegokt = True
            MsgBox ("correct gegokt")
        Else
            Poging = Poging + 1
            MsgBox ("Probeer opnieuw")
        End If
    Loop
End Sub


Sub Main()
    Poging = 0

    stage (1)
    stage (2)
    stage (3)
    stage (4)

    MsgBox ("Aantal pogingen: " & Poging)

End Sub

CODE PRIEMGETALLEN SUBROUTINE

Option Explicit
Dim Getal As Integer


Function IsPriemGetal(Getal As Integer) As Boolean
Dim Check As Integer
Dim Priem As Integer
    For Priem = 2 To (Getal - 1)
        Check = Getal Mod Priem
        If Check = 0 Then
            IsPriemGetal = False
            Exit For
        End If
    Next Priem
    If Not Check = 0 Then
        IsPriemGetal = True
    End If
End Function


Sub main()
    Getal = InputBox("voer getal in")
    If IsPriemGetal(Getal) Then
        MsgBox ("Priem")
    Else
        MsgBox ("Niet priem")
    End If
End Sub


CODE LETTERS VERVANGEN
Option Explicit
Dim Tekst As String
Dim Van As String
Dim Naar As String


Sub main()
Tekst = InputBox("Vul een tekst in die u wilt converteren")
Van = InputBox("Vul een letter in die vervangen moet worden")
Naar = InputBox("Vul een letter in waarin het moet veranderen")
MsgBox (EA(Tekst, Van, Naar))

End Sub

Function EA(Tekst As String, Van As String, Naar As String) As String
Dim LTekst As Integer
Dim EACheck As Integer
    LTekst = Len(Tekst)
        For EACheck = 1 To LTekst
            If Mid(Tekst, EACheck, 1) = Van Then
                EA = EA + Naar
            'ElseIf Mid(Tekst, EACheck, 1) = "E" Then
                'EA = EA + "A"
            Else
                EA = EA + Mid(Tekst, EACheck, 1)
            End If
        Next EACheck

End Function

CODE PRIEMGETALLEN MET LISTBOX ADDITEM

Private Sub CmdExe_Click()
Dim van As Integer
Dim Naar As Integer

van = CInt(TxtGetal1.Text)
Naar = CInt(TxtGetal2.Text)

ListBox.Clear

For Getal = van To Naar
    For priem = 2 To (Getal - 1)
        Check = Getal Mod priem
        If Check = 0 Then
            Exit For
        End If
    Next priem
        If Not Check = 0 Then
        ListBox.AddItem (Getal)
        End If
Next Getal

End Sub

CODE PAKKING

Option Explicit
Dim Dikte As Double
Dim Afstand As Double
Dim GG As Double
Dim KG As Double
Dim GGA As Double
Dim KGA As Double

Dim Check As Boolean

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim myDimension As SldWorks.Dimension

Function IsGeldigeToets(KeyAscii As MSForms.ReturnInteger) As Boolean
    If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 9 Or KeyAscii = 127 Or KeyAscii = 44 Then
        IsGeldigeToets = True
    End If
End Function

Function Wit() As Long
Wit = RGB(255, 255, 255)
End Function

Function Rood() As Long
Rood = RGB(255, 0, 0)
End Function


Private Sub CmdBuild_Click()
    Feedback.Clear
    If TxtDikte = "" Or txtAfstand = "" Or txtGG = "" Or txtGGA = "" Or txtKG = "" Or txtKGA = "" Then
        MsgBox ("voer in alle lege vakken een getal in")
    Else

        Dikte = CDbl(TxtDikte.Text) / 1000
        Afstand = CDbl(txtAfstand.Text) / 1000
        GG = CDbl(txtGG.Text) / 1000
        KG = CDbl(txtKG.Text) / 1000
        GGA = CDbl(txtGGA.Text) / 1000
        KGA = CDbl(txtKGA.Text) / 1000

        Check = False
        If (KGA * 2) <= KG Then
            Feedback.AddItem ("Klein gat afronding moet groter zijn dan klein gat")
            Feedback.AddItem ("")
            Check = True
        End If
        If GGA <= KGA Then
            Feedback.AddItem ("Groot gat afronding moet groter zijn dan klein gat afronding")
            Feedback.AddItem ("")
            Check = True
        End If
        If GG + KG >= Afstand Then
            Feedback.AddItem ("Gaten overlappen elkaar; Vergroot afstand of verklein gaten")
            Feedback.AddItem ("")
            Check = True
        End If
        If (GGA * 2) <= GG Then
            Feedback.AddItem ("Groot gat afronding moet groter zijn dan groot gat")
            Feedback.AddItem ("")
            Check = True
        End If
        If GGA >= (Afstand / 2) + (KGA) Then
            Feedback.AddItem ("Groot gat afronding moet kleiner zijn dan" & (Afstand / 2 + KGA))
            Feedback.AddItem ("")
            Check = True
        End If
        If Check = False Then

            Set swApp = Application.SldWorks
            Set Part = swApp.ActiveDoc

            Set myDimension = Part.Parameter("Dikte@Extrude1@Pakking.Part")
            myDimension.SystemValue = Dikte
            Set myDimension = Part.Parameter("GatGroot@Sketch1@Pakking.Part")
            myDimension.SystemValue = GG
            Set myDimension = Part.Parameter("AfrondingZij@Sketch1@Pakking.Part")
            myDimension.SystemValue = GGA
            Set myDimension = Part.Parameter("AfstandCenters@Sketch1@Pakking.Part")
            myDimension.SystemValue = Afstand
            Set myDimension = Part.Parameter("GatKlein@Sketch1@Pakking.Part")
            myDimension.SystemValue = KG
            Set myDimension = Part.Parameter("AfrondingKop@Sketch1@Pakking.Part")
            myDimension.SystemValue = KGA

            boolstatus = Part.ForceRebuild3(False)
            Part.ViewZoomtofit2

        End If
    End If
End Sub


Private Sub txtAfstand_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) Then
        txtAfstand.BackColor = Wit
    Else
        KeyAscii = 0
        txtAfstand.BackColor = Rood
    End If

End Sub

Private Sub txtDikte_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) Then
        TxtDikte.BackColor = Wit
    Else
        KeyAscii = 5
        TxtDikte.BackColor = Rood
    End If

End Sub

Private Sub txtGG_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) = True Then
        txtGG.BackColor = Wit
    Else
        KeyAscii = 0
        txtGG.BackColor = Rood
    End If

End Sub

Private Sub txtGGA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) = True Then
        txtGGA.BackColor = Wit
    Else
        KeyAscii = 0
        txtGGA.BackColor = Rood
    End If

End Sub

Private Sub txtKG_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) = True Then
        txtKG.BackColor = Wit
    Else
        KeyAscii = 0
        txtKG.BackColor = Rood
    End If

End Sub

Private Sub txtKGA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If IsGeldigeToets(KeyAscii) = True Then
        txtKGA.BackColor = Wit
    Else
        KeyAscii = 0
        txtKGA.BackColor = Rood
    End If

End Sub