De code werkte eerst maar nu niet meer?
Ik denk dat het tussen regel 6 en 19 zit maar ben niet zeker.
Foutopsporing leid naar commandobutton, maar code is enkel om formulier te open
Ik denk dat het tussen regel 6 en 19 zit maar ben niet zeker.
Foutopsporing leid naar commandobutton, maar code is enkel om formulier te open
HTML:
Private Sub cmdopen_2_Click()
Userform1.Show
End Sub
HTML:
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