Foutmelding 13

Private Sub cmdopen_2_Click()
    Userform1.Show
End Sub

Option Explicit

Dim blnNew As Boolean
Dim Dic As Object, i As Long

Private Sub UserForm_Initialize()
  
    cmdSave.Enabled = False
    Frame2.Enabled = False
    
Dim sv, i As Long
sv = Sheets(1).Cells(1).CurrentRegion
   Set Dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(sv)
      If Not Dic.exists(sv(i, 1)) Then Dic.Item(sv(i, 1)) = Array(sv(i, 1), CreateObject("scripting.dictionary"), CreateObject("scripting.dictionary"))
        Dic(sv(i, 1))(1).Item(sv(i, 2)) = Dic(sv(i, 1))(1).Item(sv(i, 2))
        Dic(sv(i, 1))(2).Item(sv(i, 2)) = Array(sv(i, 2), Application.Index(sv, i, Array(1, 3, 6, 7, 10, 11)), i)
    Next i
 ComboBox2.List = Dic.keys


Dim wb As Workbook: Set wb = ThisWorkbook
Dim WS As Worksheet
Dim LastRow As Long
Dim aCell As Range

Set WS = wb.Sheets("Type data")

With WS
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    
    For Each aCell In .Range("C1:C" & LastRow)
        If aCell.Value <> "" Then
            Me.TextBox2.AddItem aCell.Value
        End If
    Next
End With



Set WS = wb.Sheets("Type data")

With WS
    LastRow = .Cells(.Rows.Count, "O").End(xlUp).Row
    
    For Each aCell In .Range("O1:O" & LastRow)
        If aCell.Value <> "" Then
            Me.TextBox5.AddItem aCell.Value
        End If
    Next
End With
End Sub

Private Sub cmdClose_Click()
    If cmdClose.Caption = "Close" Then
        Unload Me
    Else
        cmdClose.Caption = "Close"
        cmdNew.Enabled = True
        
        
    End If
End Sub

Private Sub cmdNew_Click()
    blnNew = True
    txtklant.Text = ""
    txttype.Text = ""
    txtdossier.Text = ""
    txtdatum.Text = ""
    txtbestand.Text = ""
    txtbestemming.Text = ""
    
    cmdClose.Caption = "Cancel"
    cmdNew.Enabled = False
    cmdSave.Enabled = True
    Frame2.Enabled = True
End Sub

Private Sub cmdSave_Click()
    If Trim(txtklant.Text) = "" Then
        MsgBox "Enter klant", vbCritical, "Save"
        txtklant.SetFocus
        Exit Sub
    End If
    Call prSave
    cmdClose.Caption = "Close"
    cmdNew.Enabled = True
    ThisWorkbook.Save
    
End Sub
Private Sub prSave()
     ''''' Save the dms
    If blnNew = True Then
        TRows = Worksheets("dms").Range("A1").CurrentRegion.Rows.Count
        With Worksheets("dms").Range("A1")
            .Offset(TRows, 0).Value = txtklant.Text
            .Offset(TRows, 1).Value = txttype.Text
            .Offset(TRows, 2).Value = txtdossier.Text
            .Offset(TRows, 3).Value = txtdatum.Text
            .Offset(TRows, 4).Value = txtbestand.Text
            .Offset(TRows, 11).Value = txtbestemming.Text
         End With
            txtklant.Text = ""
            txttype.Text = ""
            txtdossier.Text = ""
            txtdatum.Text = ""
            txtbestand.Text = ""
            txtbestemming.Text = ""
            Call prComboBoxFill
     Else
        For i = 2 To TRows
            If Trim(Worksheets("dms").Cells(i, 1).Value) = Trim(ComboBox3.Text) Then
                Worksheets("dms").Cells(i, 1).Value = txtklant.Text
                Worksheets("dms").Cells(i, 2).Value = txttype.Text
                Worksheets("dms").Cells(i, 3).Value = txtdossier.Text
                Worksheets("dms").Cells(i, 4).Value = txtdatum.Text
                Worksheets("dms").Cells(i, 5).Value = txtbestand.Text
                Worksheets("dms").Cells(i, 13).Value = txtbestemming.Text
                txtklant.Text = ""
                txttype.Text = ""
                txtdossier.Text = ""
                txtdatum.Text = ""
                txtbestand.Text = ""
                txtbestemming.Text = ""
                Exit For
            End If
        Next i
      End If
    blnNew = False
    
    If Trim(txtklant.Text) = "" Then
        cmdSave.Enabled = False
        Frame2.Enabled = False
    Else
        cmdSave.Enabled = True
        Frame2.Enabled = True
    End If
End Sub

Private Sub cmdSearch_Click()
 Userform1.Show
End Sub

Private Sub ComboBox2_Change()
 hsv
 ComboBox3.List = Dic(ComboBox2.Value)(1).keys
 ComboBox3.ListIndex = -1
End Sub


Private Sub ComboBox3_Change()
If ComboBox3.ListIndex > -1 Then
  For i = 1 To 6
         Controls("Textbox" & i).Value = Dic(ComboBox2.Value)(2)(ComboBox3.Value)(1)(i)
     
  Next i
 End If
End Sub

Private Sub hsv()
ComboBox3.ListIndex = -1
For i = 1 To 6
   Me.Controls("TextBox" & i).Value = ""
 Next i
End Sub


Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub

Private Sub Image2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub

Sub UniekeGetallenTussen()
Dim Min As Long, Max As Long
Dim i As Long, Getal As Long
   
    'Bepaal de minimum- en maximumwaarde:
    Min = 1000000
    Max = 9999999
    'Geef het aantal getallen op:
    Aantal = 1 'LET OP: dit mag niet groter zijn dan Max !
    Application.ScreenUpdating = True
   
   TRows = Worksheets("blad1").Range("F1").CurrentRegion.Rows.Count
           
   
    'Columns("F:F").Select
        
     For i = 1 To Aantal
        Do
            Getal = Rnd * (Max - Min)
            Getal = Getal + Min
        Loop Until Range("F1:F" & i).Find(Getal, LookAt:=xlWhole) Is Nothing
        Range("F" & i) = Getal
    Next i
  
End Sub