Dim Myarray() As String , kan dit corrupt zijn ?

kareltje555 · 1 dec 2016

geachte ..

ik heb een, voor mijj onbegrijpelijk probleem.
ik heb een - al zeg ik het zelf - aardig dingetje gemaakt , met zeer gewaardeerde hulp van helpmij, waarin bijzonderheden van patienten in wordt bijgehouden.
echter nu is het zo, dat de array of string de data niet meer volledig in het formulier "OnOfHold" wordt getoond.

gcaforms is heet het en daginstroom is de dagelijks verse instroom van patienten die dagelijks geimporteerd wordt . knop op form en blad.

ik pieker me suf, speur me suf , ik probeer van alles uit, maar snap het gewoon niet (meer).

heel graag uw advies cq hulp

mvg radeloze charlie

snb · 1 dec 2016

Waar moeten we wat zoeken ?? Waar heb je het over ??
Waarom 2 bestanden ?? Wat hebben die met elkaar van doen ??

Ik dacht dat je inmiddels wel wist hoe je een listbox/combobox moet vullen:

1 regel is voldoende:

Code:

  ListOfData.List = Range("ListOfData").Cells(1).CurrentRegion.Value

De opmaak, zoals .columncount, doe je niet in de code maar tijdens de ontwerpfase van het formulier.

De click resp. change-gebeurtenis van ListOfData moet je natuurlijk test op de waarde van de .listindex: als die -1 is loopt de macro in de soep.

Als je de tekstvakken slimme namen geeft kun je alles met een 3-regelige lus doen:

Code:

Private Sub ListOfData_change()
   if ListOfData.listindex>-1 then
     for j=0 to ubound(ListOfData.list,2)
        Me("tekstvak_" & j).text=ListOfData.column(j)
     next
   end if
End Sub

kareltje555 · 3 dec 2016

ik ben maar een echte hele echte rookie op dit gebied.

Beste SNB,

helaas moet ik wederom erkennen dat ik echt een niks ben op dit gebied,
je mag me alles van medische zaken vragen , maar hier ben ik toch echt een rookie.

ik ben daarom zo gelukkig met dit forum en met mensen zoals jij. !!

snel een kop koffie pakken en gaan proberen.

Dank alvast

groet charles

kareltje555 · 3 dec 2016

2 bestanden ??

het 2e bestand is de data die dagelijks met de import knop op onder andere blad data , ingelezen wordt, als nieuw patienten instroom.

kareltje555 · 3 dec 2016

Heel erg verdrietig ben ik omdat ik niet begrijp wat SNB nu bedoeld met zijn oplossing !
Het lukt mij niet om hetgeen eerder wel werkte nu niet functioneel te krijgen .
Hopelijk mag ik nog eens op jou enorme kennis bouwen .

MVG Charles

Code:

Private Sub UserForm_Initialize()
'' Application.ScreenUpdating = False

CBmedewerker.Value = Sheets("Gegevens").Range("C81").Value
CBfunctie.Value = Sheets("Gegevens").Range("C82").Value
CBwerklocatie.Value = Sheets("Gegevens").Range("C50").Value

 TBdatum_van_cal.Value = Format(Date, "dd/mm/yyyy")
 TBdatumophef.Value = Format(Date, "dd/mm/yyyy")
 TBdatumrood.Value = Format(Date, "dd/mm/yyyy")
 TBstartdatum.Value = Format(Date, "dd/mm/yyyy")
 ChB_delete_db_jn.Value = False
 ChBZoCo_jn.Value = False
 
 CBmedewerker.List = Sheets("Gegevens").Range("C2:C30").Value
 CBZoCo.List = Sheets("Gegevens").Range("C2:C30").Value
 CBfunctie.List = Sheets("Gegevens").Range("D2:D10").Value
 CBlvh.List = Sheets("Gegevens").Range("J2:J196").Value
 'CBwerklocatie.List = Sheets("Gegevens").Range("t2:t15").Value
 CBnw_locatie.List = Sheets("GCA_NAW").Range("a2:a140").Value


Application.GoTo Sheets("data").Cells(1)
 TBid.Value = WorksheetFunction.Max(Worksheets("data").Range("A3:A65536")) + 1


  Dim rng As Range
    Dim I As Long, j As Long, rw As Long
    Dim Myarray() As String
    Set rng = Range("ListOfData")
    With Me.ListOfData
        .Clear
        .ColumnHeads = False
        .ColumnCount = rng.Columns.Count            'start                                    '  anders tekst
        .ColumnWidths = "20;50;50;60;40;15;40;50;0;0;50;30;50;50;20;20;20;0;00;20;20;20;20;70;50;70;70;70;00;00;25;000;00;60;60;100;100;50"
    ReDim Myarray(rng.Rows.Count, rng.Columns.Count)
    rw = 0
            For I = 1 To rng.Rows.Count
            For j = 0 To rng.Columns.Count
                Myarray(rw, j) = rng.Cells(I, j + 1)
            Next
            rw = rw + 1
        Next
        .List = Myarray
        End With
        If Val(Me.txtLBSelectionIndex) > 1 Then
        Me.ListOfData.Selected(Val(Me.txtLBSelectionIndex)) = True
    End If
    
    '' Application.ScreenUpdating = True
    
End Sub
Private Sub ListOfData_change()
   If ListOfData.ListIndex > -1 Then
     For j = 0 To UBound(ListOfData.List, 2)
        Me("tekstvak_" & j).Text = ListOfData.Column(j)
     Next
   End If
End Sub
Private Sub OOOOOLLLLLLLDDDDDDDListOfData_Click()         ' AANKLIKKEN VAN DE REGEL EN LADEN IN FORM
''Application.ScreenUpdating = False

Application.GoTo Sheets("data").Cells(1)
'' opbdeleteja.Value = False
'' OBcopynaarzoco.Value = False

CBmedewerker.Value = Sheets("Gegevens").Range("C81").Value
CBfunctie.Value = Sheets("Gegevens").Range("C82").Value
CBwerklocatie.Value = Sheets("Gegevens").Range("C50").Value
ChB_delete_db_jn.Value = False


Dim rngMyData As Range
    TBid.Value = Me.ListOfData.Column(0)
    TBcoa_nr.Value = Me.ListOfData.Column(1)
    TBv_nr.Value = Me.ListOfData.Column(2)
    TBa_naam.Value = Me.ListOfData.Column(3)
    TBv_naam.Value = Me.ListOfData.Column(4)
    TBm_v.Value = Me.ListOfData.Column(5)
    CBlvh.Value = Me.ListOfData.Column(6)
    TBgeb_datum.Value = Me.ListOfData.Column(7)
    TBclassificatie.Value = Me.ListOfData.Column(8)
    TBlocatie.Value = Me.ListOfData.Column(9)
    TBstartdatum.Value = Me.ListOfData.Column(10)
    TBCode.Value = Me.ListOfData.Column(11)
    TBdatumrood.Value = Me.ListOfData.Column(12)
    TBdatumophef = Me.ListOfData.Column(13)
    TBzwanger.Value = Me.ListOfData.Column(14)
    TBweken.Value = Me.ListOfData.Column(15)
    TBrolstoel.Value = Me.ListOfData.Column(16)
    CBwerklocatie.Value = Me.ListOfData.Column(17)
    TextBox4.Value = Me.ListOfData.Column(18)      'is nog ongebruikt
    TBaczkhs.Value = Me.ListOfData.Column(19)
    TBdialyse.Value = Me.ListOfData.Column(20)
    TBazcmod.Value = Me.ListOfData.Column(21)
    TBanders.Value = Me.ListOfData.Column(22)
    TBanderstekst.Value = Me.ListOfData.Column(23)
    TBtoelichting.Value = Me.ListOfData.Column(24)
    CBnw_locatie.Value = Me.ListOfData.Column(25)
    TBemaillocatie.Value = Me.ListOfData.Column(26)
    TBtelnummerlocatie.Value = Me.ListOfData.Column(27)
    CBmedewerker.Value = Me.ListOfData.Column(28)
    CBfunctie.Value = Me.ListOfData.Column(29)
    Tbdelete.Value = Me.ListOfData.Column(30)
    TBheeftzoco.Value = Me.ListOfData.Column(31)
    '' OPBdelete_db_ja.Value = Me.ListOfData.Column(32)
    CBZoCo.Value = Me.ListOfData.Column(33)
    CBzorgdomein.Value = Me.ListOfData.Column(34)
    Set rngMyData = Sheets("data").Columns("A")
    
    ''Application.ScreenUpdating = True
    
End Sub
Private Sub cmdUpdate_Click()  'opgehaalde en aangepaste gegevens weer wegschrijven


''Application.ScreenUpdating = False

Application.GoTo Sheets("data").Cells(1)


Dim lngMyRow As Long
Dim r As Long
Dim rng As Range, fnd As Range
Dim Ctrl As Control
Set rng = Blad3.Range("A3:A" & Blad3.Cells(Rows.Count, "A").End(xlUp).Row)
Set fnd = rng.Find(what:=OnOfHold.TBid.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Me.TBid = vbNullString Then
        MsgBox "Aanpassen is niet mogelijk, geen ingaves gevonden", vbExclamation
        Exit Sub
    ElseIf Not fnd Is Nothing Then
        Application.EnableEvents = False
            For r = 0 To Me.ListOfData.ListCount - 1
                If Me.ListOfData.Selected(r) Then
                    Me.txtLBSelectionIndex = r
                    Exit For
                End If
            Next r
    Cells(fnd.Row, "A").Value = TBid.Text
    Cells(fnd.Row, "B").Value = TBcoa_nr.Text
    Cells(fnd.Row, "C").Value = TBv_nr.Text
    Cells(fnd.Row, "D").Value = TBa_naam.Text
    Cells(fnd.Row, "E").Value = TBv_naam.Text
    Cells(fnd.Row, "F").Value = TBm_v.Text
    Cells(fnd.Row, "G").Value = CBlvh.Text
    Cells(fnd.Row, "H").Value = TBgeb_datum.Text
    Cells(fnd.Row, "I").Value = TBclassificatie.Text
    Cells(fnd.Row, "J").Value = TBlocatie.Text
    Cells(fnd.Row, "K").Value = TBstartdatum.Text
    Cells(fnd.Row, "l").Value = TBCode.Text
    Cells(fnd.Row, "m").Value = TBdatumrood.Text
    Cells(fnd.Row, "n").Value = TBdatumophef.Text
    Cells(fnd.Row, "o").Value = TBzwanger.Text
    Cells(fnd.Row, "p").Value = TBweken.Text
    Cells(fnd.Row, "q").Value = TBrolstoel.Text
    Cells(fnd.Row, "r").Value = CBwerklocatie.Text
    Cells(fnd.Row, "s").Value = ""
    Cells(fnd.Row, "t").Value = TBaczkhs.Text
    Cells(fnd.Row, "u").Value = TBdialyse.Text
    Cells(fnd.Row, "v").Value = TBazcmod.Text
    Cells(fnd.Row, "w").Value = TBanders.Text
    Cells(fnd.Row, "x").Value = TBanderstekst.Text
    Cells(fnd.Row, "y").Value = TBtoelichting.Text
    Cells(fnd.Row, "z").Value = CBnw_locatie.Text
    Cells(fnd.Row, "aa").Value = TBemaillocatie.Text
    Cells(fnd.Row, "ab").Value = TBtelnummerlocatie.Text
    Cells(fnd.Row, "ac").Value = CBmedewerker.Text
    Cells(fnd.Row, "ad").Value = CBfunctie.Text
    Cells(fnd.Row, "ae").Value = Tbdelete.Text
    Cells(fnd.Row, "af").Value = TBheeftzoco.Text
    Cells(fnd.Row, "Ag").Value = TBdelete_db_ja.Text
    Cells(fnd.Row, "ah").Value = CBZoCo.Text
    Cells(fnd.Row, "ai").Value = CBzorgdomein.Text
        Application.EnableEvents = True
    End If
     MsgBox "De aanpassingen zijn opgeslagen!"
     For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
    Ctrl.Value = ""
    End If
Next Ctrl

For Each cl In Range("ae3:ae45000")
If cl = "ja" Or cl = "Ja" Or cl = "WAAR" Then                             ''  Or cl = 72 Then
cl.Rows.EntireRow.Delete
End If
Next

Call UserForm_Initialize
Me.TBid.Value = WorksheetFunction.Max(Worksheets("data").Range("A3:A65536")) + 1

'' Call sorteer_data_code

'' Application.ScreenUpdating = True

End Sub
Private Sub cmbmailophefblokkade_Click()             'OPHEFFEN BLOKKADE




'' Application.ScreenUpdating = False
Sheets("OnOfHold").Range("D11").Value = ""
Sheets("OnOfHold").Range("h11").Value = ""
Sheets("OnOfHold").Range("D12").Value = ""
Sheets("OnOfHold").Range("h12").Value = ""
Sheets("OnOfHold").Range("D13").Value = ""
Sheets("OnOfHold").Range("h13").Value = ""
Sheets("OnOfHold").Range("h14").Value = ""
Sheets("OnOfHold").Range("D15").Value = ""
Sheets("OnOfHold").Range("D16").Value = ""
Sheets("OnOfHold").Range("D17").Value = ""
Sheets("OnOfHold").Range("B27").Value = "*"
Sheets("OnOfHold").Range("B36").Value = "*"
Sheets("OnOfHold").Range("E31").Value = ""
Sheets("OnOfHold").Range("C31").Value = ""
Sheets("OnOfHold").Range("C33").Value = "*"
Sheets("OnOfHold").Range("C41").Value = "*"
Sheets("OnOfHold").Range("I41").Value = ""
Sheets("OnOfHold").Range("C43").Value = "*"
Sheets("OnOfHold").Range("C45").Value = "*"
Sheets("OnOfHold").Range("C47").Value = "*"
Sheets("OnOfHold").Range("C49").Value = "*"
Sheets("OnOfHold").Range("C52").Value = "*"
Sheets("OnOfHold").Range("D53").Value = ""
Sheets("OnOfHold").Range("l103").Value = ""

Sheets("OnOfHold").Range("D11").Value = TBv_naam.Value
Sheets("OnOfHold").Range("h11").Value = TBa_naam.Value
Sheets("OnOfHold").Range("D12").Value = TBgeb_datum.Value
Sheets("OnOfHold").Range("I12").Value = TBm_v.Value
Sheets("OnOfHold").Range("D13").Value = TBv_nr.Value
Sheets("OnOfHold").Range("h13").Value = TBcoa_nr.Value
Sheets("OnOfHold").Range("h14").Value = CBlvh.Value
Sheets("OnOfHold").Range("D15").Value = CBwerklocatie.Value
Sheets("OnOfHold").Range("D16").Value = CBmedewerker.Value
Sheets("OnOfHold").Range("D17").Value = CBfunctie.Value

If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B27").Value = "R"
If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B36").Value = "*"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B36").Value = "R"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B27").Value = "*"


If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "R"
If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("E31").Value = TBdatumrood.Value


If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C33").Value = "R"    'klopt
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "*"
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("e31").Value = ""
'volgende regel is nieuw
' tbstartdatum
'If TBdatumophef.Value <> TBdatumrood.Value Then Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value
'If TBdatumophef.Value <> "" Then Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value    'als datum ophef blokkade bekend is dan op l103 schrijven
If TBdatumrood.Value <> "" Then TBdatumophef.Value = TBdatumrood.Value
Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value

If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("C41").Value = "R"
If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("I41").Value = TBweken.Value
If TBrolstoel.Value = "Ja" Then Sheets("OnOfHold").Range("C43").Value = "R"
If TBaczkhs.Value = "Ja" Then Sheets("OnOfHold").Range("C45").Value = "R"
If TBdialyse.Value = "Ja" Then Sheets("OnOfHold").Range("C47").Value = "R"
If TBazcmod.Value = "Ja" Then Sheets("OnOfHold").Range("C49").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("C52").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("D53").Value = TBanderstekst.Value

Call mail_onofhold_opheffen_blokkade             'module mail- formulier X als pdf

End Sub
Private Sub CBnw_locatie_Change()
Sheets("OnOfHold").Range("d114").Value = CBnw_locatie
TBemaillocatie.Value = Sheets("OnOfHold").Range("d115").Value
TBtelnummerlocatie.Value = Sheets("OnOfHold").Range("d119").Value
End Sub
Private Sub Cmbopvragen_nw_loc_Click()                           ' knop = opvragen waart pat naar toe gaat
Sheets("gegevens").Range("w27").Value = TBv_naam.Value
Sheets("gegevens").Range("x27").Value = TBa_naam.Value
Sheets("gegevens").Range("u31").Value = TBgeb_datum.Value
Sheets("gegevens").Range("u32").Value = TBm_v.Value
Sheets("gegevens").Range("u33").Value = TBv_nr.Value
Sheets("gegevens").Range("u34").Value = TBcoa_nr.Value
    Call mail_coaplaatsing_waar                                      ' in module mail formulier x as pdf
End Sub
Private Sub CMBrecept_Click()
Sheets("OnOfHold").Range("D11").Value = TBv_naam.Value
Sheets("OnOfHold").Range("h11").Value = TBa_naam.Value
Sheets("OnOfHold").Range("D12").Value = TBgeb_datum.Value
Sheets("OnOfHold").Range("h12").Value = TBm_v.Value
Sheets("OnOfHold").Range("D13").Value = TBv_nr.Value
Sheets("OnOfHold").Range("h13").Value = TBcoa_nr.Value
Sheets("OnOfHold").Range("h14").Value = CBlvh.Value
Sheets("OnOfHold").Range("D15").Value = CBwerklocatie.Value
Sheets("OnOfHold").Range("D16").Value = CBmedewerker.Value
Sheets("OnOfHold").Range("D17").Value = CBfunctie.Value
RECEPT.Show
End Sub



Private Sub CMBsoep_Click()
Sheets("OnOfHold").Range("D11").Value = TBv_naam.Value
Sheets("OnOfHold").Range("h11").Value = TBa_naam.Value
Sheets("OnOfHold").Range("D12").Value = TBgeb_datum.Value
Sheets("OnOfHold").Range("h12").Value = TBm_v.Value
Sheets("OnOfHold").Range("D13").Value = TBv_nr.Value
Sheets("OnOfHold").Range("h13").Value = TBcoa_nr.Value
Sheets("OnOfHold").Range("h14").Value = CBlvh.Value
Sheets("OnOfHold").Range("D15").Value = CBwerklocatie.Value
Sheets("OnOfHold").Range("D16").Value = CBmedewerker.Value
Sheets("OnOfHold").Range("D17").Value = CBfunctie.Value
SOEP.Show
End Sub





Private Sub TBdatumophef_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
CalendarFrm.Show
TBdatumophef.Value = TBdatum_van_cal.Value
TBdatumtransfer.Value = TBdatum_van_cal.Value
End Sub
Private Sub Cmbmailonofhold_Click()



''Application.ScreenUpdating = False
Sheets("OnOfHold").Range("D11").Value = ""
Sheets("OnOfHold").Range("I11").Value = ""
Sheets("OnOfHold").Range("D12").Value = ""
Sheets("OnOfHold").Range("I12").Value = ""
Sheets("OnOfHold").Range("D13").Value = ""
Sheets("OnOfHold").Range("I13").Value = ""
Sheets("OnOfHold").Range("I14").Value = ""
Sheets("OnOfHold").Range("D15").Value = ""
Sheets("OnOfHold").Range("D16").Value = ""
Sheets("OnOfHold").Range("D17").Value = ""
Sheets("OnOfHold").Range("B27").Value = "*"
Sheets("OnOfHold").Range("B36").Value = "*"
Sheets("OnOfHold").Range("E31").Value = ""
Sheets("OnOfHold").Range("C31").Value = ""
Sheets("OnOfHold").Range("C33").Value = "*"
Sheets("OnOfHold").Range("C41").Value = "*"
Sheets("OnOfHold").Range("I41").Value = ""
Sheets("OnOfHold").Range("C43").Value = "*"
Sheets("OnOfHold").Range("C45").Value = "*"
Sheets("OnOfHold").Range("C47").Value = "*"
Sheets("OnOfHold").Range("C49").Value = "*"
Sheets("OnOfHold").Range("C52").Value = "*"
Sheets("OnOfHold").Range("D53").Value = ""
Sheets("OnOfHold").Range("l103").Value = ""

Sheets("OnOfHold").Range("D11").Value = TBv_naam.Value
Sheets("OnOfHold").Range("h11").Value = TBa_naam.Value
Sheets("OnOfHold").Range("D12").Value = TBgeb_datum.Value
Sheets("OnOfHold").Range("h12").Value = TBm_v.Value
Sheets("OnOfHold").Range("D13").Value = TBv_nr.Value
Sheets("OnOfHold").Range("h13").Value = TBcoa_nr.Value
Sheets("OnOfHold").Range("h14").Value = CBlvh.Value
Sheets("OnOfHold").Range("D15").Value = CBwerklocatie.Value
Sheets("OnOfHold").Range("D16").Value = CBmedewerker.Value
Sheets("OnOfHold").Range("D17").Value = CBfunctie.Value

If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B27").Value = "R"
If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B36").Value = "*"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B36").Value = "R"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B27").Value = "*"


If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "R"
If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("E31").Value = TBdatumrood.Value


If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C33").Value = "R"    'klopt
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "*"
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("e31").Value = ""
'volgende regel is nieuw

If TBdatumophef.Value <> "" Then Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value    'als datum ophef blokkade bekend is dan op l103 schrijven
'If TBdatumophef.Value > TBdatumophef.Value Then Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value    'als datum ophef blokkade bekend is dan op l103 schrijven

If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("C41").Value = "R"
If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("I41").Value = TBweken.Value
If TBrolstoel.Value = "Ja" Then Sheets("OnOfHold").Range("C43").Value = "R"
If TBaczkhs.Value = "Ja" Then Sheets("OnOfHold").Range("C45").Value = "R"
If TBdialyse.Value = "Ja" Then Sheets("OnOfHold").Range("C47").Value = "R"
If TBazcmod.Value = "Ja" Then Sheets("OnOfHold").Range("C49").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("C52").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("D53").Value = TBanderstekst.Value

Call ONOFHOLD_RDB_Selection_Range_To_PDF_And_Create_Mail    'met logo voorheen mail_onofhold                'iets met datum ophef in title  incl datum

''Application.ScreenUpdating = True

End Sub

Private Sub Cmbmail_nw_loc_Click()               'mail naar nw locatie ivm warme overdracht
   ' apllication.screenupdate=false
Sheets("gegevens").Range("w59").Value = TBv_naam.Value
Sheets("gegevens").Range("x59").Value = TBa_naam.Value
Sheets("gegevens").Range("u63").Value = TBgeb_datum.Value
Sheets("gegevens").Range("u64").Value = TBm_v.Value
Sheets("gegevens").Range("u65").Value = TBv_nr.Value
Sheets("gegevens").Range("u66").Value = TBcoa_nr.Value
Sheets("gegevens").Range("x70").Value = TBdatumophef.Value

Sheets("gegevens").Range("t73").Value = TBtoelichting.Value

Sheets("gegevens").Range("u89").Value = CBnw_locatie.Value
Sheets("gegevens").Range("u90").Value = TBemaillocatie.Value


' apllication.screenupdate=true

    Call Mail_wo_nw_locatie        '= is in mail selection body
End Sub
Private Sub cmdemptyonofhold_Click()    ' on of hold formulier leeg maken
Sheets("OnOfHold").Range("D11").Value = ""
Sheets("OnOfHold").Range("h11").Value = ""
Sheets("OnOfHold").Range("D12").Value = ""
Sheets("OnOfHold").Range("I12").Value = ""
Sheets("OnOfHold").Range("D13").Value = ""
Sheets("OnOfHold").Range("h13").Value = ""
Sheets("OnOfHold").Range("h14").Value = ""
Sheets("OnOfHold").Range("D15").Value = ""
Sheets("OnOfHold").Range("D16").Value = ""
Sheets("OnOfHold").Range("D17").Value = ""
Sheets("OnOfHold").Range("B27").Value = "*"
Sheets("OnOfHold").Range("B36").Value = "*"
Sheets("OnOfHold").Range("E31").Value = ""
Sheets("OnOfHold").Range("C31").Value = "*"
Sheets("OnOfHold").Range("C33").Value = "*"
Sheets("OnOfHold").Range("C41").Value = "*"
Sheets("OnOfHold").Range("I41").Value = ""
Sheets("OnOfHold").Range("C43").Value = "*"
Sheets("OnOfHold").Range("C45").Value = "*"
Sheets("OnOfHold").Range("C47").Value = "*"
Sheets("OnOfHold").Range("C49").Value = "*"
Sheets("OnOfHold").Range("C52").Value = "*"
Sheets("OnOfHold").Range("D53").Value = ""
Sheets("OnOfHold").Range("l103").Value = ""
End Sub

Private Sub cmdEmty_Click()         ' invoer scherm leeg maken

        '' Application.ScreenUpdating = False

Dim Ctrl As Control
For Each Ctrl In Me.Controls
   If TypeOf Ctrl Is MSForms.OptionButton Then
     Ctrl.Value = False
   End If
 Next
For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
    Ctrl.Value = ""
    End If
Next Ctrl
Call UserForm_Initialize
Me.TBid.Value = WorksheetFunction.Max(Worksheets("data").Range("A3:A65536")) + 1
        '' Application.ScreenUpdating = true
End Sub
Private Sub cmdSend_Click()    'nieuwe patient  = gegevens opslaan

Application.GoTo Sheets("data").Cells(1)
'' Application.ScreenUpdating = False

Dim lastrow As Long
 Dim Ctrl As Control
    lastrow = Sheets("data").Range("A" & Rows.Count).End(xlUp).Row
    If MsgBox("Correcte ingave?", vbYesNo + vbQuestion, "Kijk de gegevens na!") = vbNo Then Exit Sub
    Cells(lastrow + 1, "A").Value = TBid.Text
    Cells(lastrow + 1, "B").Value = TBcoa_nr.Text
    Cells(lastrow + 1, "C").Value = TBv_nr.Text
    Cells(lastrow + 1, "D").Value = TBa_naam.Text
    Cells(lastrow + 1, "E").Value = TBv_naam.Text
    Cells(lastrow + 1, "F").Value = TBm_v.Text
    Cells(lastrow + 1, "g").Value = CBlvh.Text
    Cells(lastrow + 1, "h").Value = TBgeb_datum.Text
    Cells(lastrow + 1, "i").Value = TBclassificatie.Text
    Cells(lastrow + 1, "J").Value = TBlocatie.Text
    
    Cells(lastrow + 1, "k").Value = TBstartdatum.Text
    Cells(lastrow + 1, "l").Value = TBCode.Text
    Cells(lastrow + 1, "m").Value = TBdatumrood.Text     'rood tot datum
    Cells(lastrow + 1, "n").Value = TBdatumophef.Text
    

    Cells(lastrow + 1, "o").Value = TBzwanger.Text
    Cells(lastrow + 1, "p").Value = TBweken.Text
    Cells(lastrow + 1, "q").Value = TBrolstoel.Text
    Cells(lastrow + 1, "r").Value = CBwerklocatie.Text

    Cells(lastrow + 1, "s").Value = ""
    Cells(lastrow + 1, "t").Value = TBaczkhs.Text
    Cells(lastrow + 1, "u").Value = TBdialyse.Text
    Cells(lastrow + 1, "v").Value = TBazcmod.Text
    Cells(lastrow + 1, "w").Value = TBanders.Text
    Cells(lastrow + 1, "x").Value = TBanderstekst.Text
    Cells(lastrow + 1, "y").Value = TBtoelichting.Text
    Cells(lastrow + 1, "z").Value = CBnw_locatie.Text
    Cells(lastrow + 1, "aa").Value = TBemaillocatie.Text
    Cells(lastrow + 1, "ab").Value = TBtelnummerlocatie.Text
    Cells(lastrow + 1, "ac").Value = CBmedewerker.Text
    Cells(lastrow + 1, "ad").Value = CBfunctie.Text
    Cells(lastrow + 1, "ae").Value = Tbdelete.Text             'als optie is ja dan regel verwijderen
    Cells(lastrow + 1, "af").Value = TBheeftzoco
    Cells(lastrow + 1, "Ag").Value = OPBdelete_db_ja.Text        'TBjaar.Text
    Cells(lastrow + 1, "ah").Value = CBZoCo.Text
    Cells(lastrow + 1, "al").Value = CBzorgdomein.Text
    MsgBox "Nieuwe ingave is opgeslagen!"
For Each Ctrl In Me.Controls
   If TypeOf Ctrl Is MSForms.OptionButton Then
     Ctrl.Value = False
   End If
 Next
For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
    Ctrl.Value = ""
    End If
Next Ctrl
Call UserForm_Initialize
Me.TBid.Value = WorksheetFunction.Max(Worksheets("data").Range("A3:A65536")) + 1
'' Call sorteer_data_code
''Application.ScreenUpdating = True
End Sub


Private Sub cmdfillonofhold_Click()           'knop om formulier te vullen
                                             'eerst leegmaken dan vullen
'Application.ScreenUpdating = False
Sheets("OnOfHold").Range("D11").Value = ""
Sheets("OnOfHold").Range("h11").Value = ""
Sheets("OnOfHold").Range("D12").Value = ""
Sheets("OnOfHold").Range("h12").Value = ""
Sheets("OnOfHold").Range("D13").Value = ""
Sheets("OnOfHold").Range("h13").Value = ""
Sheets("OnOfHold").Range("h14").Value = ""
Sheets("OnOfHold").Range("D15").Value = ""
Sheets("OnOfHold").Range("D16").Value = ""
Sheets("OnOfHold").Range("D17").Value = ""
Sheets("OnOfHold").Range("B27").Value = "*"
Sheets("OnOfHold").Range("B36").Value = "*"
Sheets("OnOfHold").Range("E31").Value = ""
Sheets("OnOfHold").Range("C31").Value = ""
Sheets("OnOfHold").Range("C33").Value = "*"
Sheets("OnOfHold").Range("C41").Value = "*"
Sheets("OnOfHold").Range("I41").Value = ""
Sheets("OnOfHold").Range("C43").Value = "*"
Sheets("OnOfHold").Range("C45").Value = "*"
Sheets("OnOfHold").Range("C47").Value = "*"
Sheets("OnOfHold").Range("C49").Value = "*"
Sheets("OnOfHold").Range("C52").Value = "*"
Sheets("OnOfHold").Range("D53").Value = ""

Sheets("OnOfHold").Range("D11").Value = TBv_naam.Value
Sheets("OnOfHold").Range("h11").Value = TBa_naam.Value
Sheets("OnOfHold").Range("D12").Value = TBgeb_datum.Value
Sheets("OnOfHold").Range("h12").Value = TBm_v.Value
Sheets("OnOfHold").Range("D13").Value = TBv_nr.Value
Sheets("OnOfHold").Range("h13").Value = TBcoa_nr.Value
Sheets("OnOfHold").Range("h14").Value = CBlvh.Value
Sheets("OnOfHold").Range("D15").Value = CBwerklocatie.Value
Sheets("OnOfHold").Range("D16").Value = CBmedewerker.Value
Sheets("OnOfHold").Range("D17").Value = CBfunctie.Value

If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B27").Value = "R"
If TBCode.Value = "Rood" Then Sheets("OnOfHold").Range("B36").Value = "*"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B36").Value = "R"
If TBCode.Value = "Oranje" Then Sheets("OnOfHold").Range("B27").Value = "*"


If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "R"
If TBdatumrood.Value <> "Datum nog onbekend" Then Sheets("OnOfHold").Range("E31").Value = TBdatumrood.Value


If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C33").Value = "R"    'klopt
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("C31").Value = "*"
If TBdatumrood.Value = "Datum nog onbekend" Then Sheets("OnOfHold").Range("e31").Value = ""
'volgende regel is nieuw
' tbstartdatum
If TBdatumophef.Value <> "" Then Sheets("OnOfHold").Range("l103").Value = TBdatumophef.Value    'als datum ophef blokkade bekend is dan op l103 schrijven

If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("C41").Value = "R"
If TBzwanger.Value = "Ja" Then Sheets("OnOfHold").Range("I41").Value = TBweken.Value
If TBrolstoel.Value = "Ja" Then Sheets("OnOfHold").Range("C43").Value = "R"
If TBaczkhs.Value = "Ja" Then Sheets("OnOfHold").Range("C45").Value = "R"
If TBdialyse.Value = "Ja" Then Sheets("OnOfHold").Range("C47").Value = "R"
If TBazcmod.Value = "Ja" Then Sheets("OnOfHold").Range("C49").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("C52").Value = "R"
If TBanders.Value = "Ja" Then Sheets("OnOfHold").Range("D53").Value = TBanderstekst.Value

' hier moet dan aanroepen van mudule mail Onof hold met pdf komen  = module mail_formulier X als pdf
' Call mail_onofhold_met_pdf
' Call mail_onofhold            '= module mail_formulier X als pdf

'' Application.ScreenUpdating = True
End Sub


Private Sub CheckBox1_Click()         ''opbdeleteja_Click()
antwoord = MsgBox("Weet je het zeker ?    " & vbCr & "Bij het afsluiten van dit scherm" & vbCr & "zal de de patiënt voorgoed uit de database verwijderd worden !! " & vbCr & " " & vbCr & " Sla de wijzigingen op met de grote knop !!", vbYesNo)
If antwoord = vbNo Then Exit Sub
If CheckBox1.Value = True Then Tbdelete.Value = CheckBox1.Caption
'' MsgBox "Vergeet niet om de gewijzigde gegevens op te slaan met de desbetreffende knop !"
End Sub
Private Sub OpBdeletenee_Click()
If Opbdeletenee.Value = True Then Tbdelete.Value = Opbdeletenee.Caption
End Sub
Private Sub OPBRood_Click()
If OPBRood.Value = True Then TBCode.Value = OPBRood.Caption
TBstartdatum.SetFocus
CalendarFrm.Show
TBstartdatum.Value = TBdatum_van_cal.Value
End Sub
Private Sub OPBdatumrood_Click()
TBdatumrood.SetFocus
CalendarFrm.Show
TBdatumrood.Value = TBdatum_van_cal.Value
End Sub
Private Sub OPBgeendatumrood_Change()
If OPBgeendatumrood.Value = True Then TBdatumrood.Value = OPBgeendatumrood.Caption
End Sub
Private Sub OPBOranje_Click()
If OPBOranje.Value = True Then TBCode.Value = OPBOranje.Caption
If OPBOranje.Value = True Then TBdatumrood.Value = ""
CalendarFrm.Show
TBstartdatum.Value = TBdatum_van_cal.Value
End Sub
Private Sub OPBaczkhsja_Click()
If OPBaczkhsja.Value = True Then TBaczkhs.Value = OPBaczkhsja.Caption
End Sub
Private Sub OPBaczkhsnee_Click()
If OPBaczkhsnee.Value = True Then TBaczkhs.Value = OPBaczkhsnee.Caption
End Sub
Private Sub OPBandersja_Click()
If OPBandersja.Value = True Then TBanders.Value = OPBdialyseja.Caption
End Sub
Private Sub OPBandersnee_Click()
If OPBandersnee.Value = True Then TBanders.Value = OPBdialysenee.Caption
End Sub
Private Sub OPBazcmodja_Click()
If OPBazcmodja.Value = True Then TBazcmod.Value = OPBazcmodja.Caption
End Sub
Private Sub OPBazcmodnee_Click()
If OPBazcmodnee.Value = True Then TBazcmod.Value = OPBazcmodnee.Caption
End Sub
Private Sub OPBdialyseja_Click()
If OPBdialyseja.Value = True Then TBdialyse.Value = OPBdialyseja.Caption
End Sub
Private Sub OPBdialysenee_Click()
If OPBdialysenee.Value = True Then TBdialyse.Value = OPBdialysenee.Caption
End Sub
Private Sub OPBvrouw_Click()
If OPBvrouw.Value = True Then TBm_v.Value = OPBvrouw.Caption
End Sub
Private Sub OPBman_Click()
If OPBman.Value = True Then TBm_v.Value = OPBman.Caption
End Sub
Private Sub OPBrolstoelja_Click()
If OPBrolstoelja.Value = True Then TBrolstoel.Value = OPBrolstoelja.Caption
End Sub
Private Sub OPBrolstoelnee_Click()
If OPBrolstoelnee.Value = True Then TBrolstoel.Value = OPBrolstoelnee.Caption
End Sub
Private Sub OPBzwangerja_Click()
If OPBzwangerja.Value = True Then TBzwanger.Value = OPBzwangerja.Caption
End Sub
Private Sub OPBzwangernee_Click()
If OPBzwangernee.Value = True Then TBzwanger.Value = OPBzwangernee.Caption
End Sub
Private Sub OPBzwangernvt_Click()
If OPBzwangernvt.Value = True Then TBzwanger.Value = OPBzwangernvt.Caption
End Sub
Private Sub cmbonofholdprint_Click()
Call print_onofhold    'module print sheet
End Sub
Private Sub ChB_delete_db_jn_click()

If ChB_delete_db_jn.Value = True And ChBZoCo_jn.Value = False Then Tbdelete.Value = ChB_delete_db_jn.Caption

End Sub
Private Sub ChBZoCo_jn_click()
If ChBZoCo_jn.Value = True Then TBheeftzoco.Value = ChBZoCo_jn.Caption
If ChBZoCo_jn.Value = True Then ChB_delete_db_jn.Value = False
If ChBZoCo_jn.Value = True Then TBdelete_db_ja.Value = "nee"
If ChBZoCo_jn.Value = True Then Tbdelete.Value = "nee"
End Sub
Private Sub CMBsluiten_form_Click()

Application.ScreenUpdating = False
For Each cl In Range("ae3:ae45000")
If cl = "ja" Or cl = "Ja" Then
cl.Rows.EntireRow.Delete
End If
Next
Application.ScreenUpdating = True

Application.GoTo Sheets("welkom").Cells(1)
Unload Me
End Sub
Private Sub Cmbescape_Click()
Unload Me
End Sub
Private Sub CBwerklocatie_Change()
Sheets("Gegevens").Range("C50").Value = CBwerklocatie.Value
End Sub

Dim Myarray() As String , kan dit corrupt zijn ?

kareltje555

Gebruiker

Bijlagen

snb

Verenigingslid

kareltje555

Gebruiker

kareltje555

Gebruiker

kareltje555

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy