Ga naar inhoud

Aanbevolen berichten

Geplaatst:

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

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

 

test_DMS.xlsm

Gast
Dit topic is nu gesloten voor nieuwe reacties.
×
×
  • Nieuwe aanmaken...

Belangrijke informatie

We hebben cookies geplaatst op je toestel om deze website voor jou beter te kunnen maken. Je kunt de cookie instellingen aanpassen, anders gaan we er van uit dat het goed is om verder te gaan.