Bestaande Code inkorten

[MEradus]

Hallo Kenners,

Ik ben nog steeds lerende in de wondere wereld van VBA en nu heb ik weer wat hulp nodig.

In het verleden zelf een urenverantwoordings formulier gemaakt met heel veel code.
Maar nu kom ik er achter dat ik met een kleine verandering heel veel werk heb.
Omdat ik met zakelijke informatie zit probeer ik mijn 'probleem' eerst uit te leggen d.m.v een plaatje en een stukje code.
Mocht dit niet duidelijk genoeg zijn zal ik proberen om een voorbeeld bestandje te maken.




Bij het openen van het urenbestand wordt naar aanleiding van de "application.username" het formulier gevuld met de rooster tijden van de persoon. (zie plaatje)

Zoals je in dit plaatje kunt zien is het formulier voorzien van meerdere comboboxen en dtpickers.
De code die achter de eerste combobox hangt is:

Private Sub ComboBox1_Change()

If ComboBox1.Value = "DV001" Then
DTPicker1.Value = "06:00:00"
DTPicker2.Value = "14:30:00"
ElseIf ComboBox1.Value = "DV002" Then
DTPicker1.Value = "07:00:00"
DTPicker2.Value = "15:30:00"
ElseIf ComboBox1.Value = "DL001" Then
DTPicker1.Value = "14:15:00"
DTPicker2.Value = "22:45:00"
ElseIf ComboBox1.Value = "DL002" Then
DTPicker1.Value = "15:15:00"
DTPicker2.Value = "23:45:00"
ElseIf ComboBox1.Value = "CV001" Then
DTPicker1.Value = "07:00:00"
DTPicker2.Value = "15:30:00"
ElseIf ComboBox1.Value = "CV002" Then
DTPicker1.Value = "08:00:00"
DTPicker2.Value = "16:30:00"
ElseIf ComboBox1.Value = "CV003" Then
DTPicker1.Value = "08:30:00"
DTPicker2.Value = "17:00:00"
ElseIf ComboBox1.Value = "CL001" Then
DTPicker1.Value = "13:00:00"
DTPicker2.Value = "21:30:00"
ElseIf ComboBox1.Value = "CL002" Then
DTPicker1.Value = "13:30:00"
DTPicker2.Value = "22:00:00"
ElseIf ComboBox1.Value = "CL101" Then
DTPicker1.Value = "13:00:00"
DTPicker2.Value = "22:00:00"
ElseIf ComboBox1.Value = "CV102" Then
DTPicker1.Value = "09:00:00"
DTPicker2.Value = "15:00:00"
ElseIf ComboBox1.Value = "CV103" Then
DTPicker1.Value = "08:00:00"
DTPicker2.Value = "17:30:00"
ElseIf ComboBox1.Value = "RV001" Then
DTPicker1.Value = "07:45:00"
DTPicker2.Value = "16:15:00"
ElseIf ComboBox1.Value = "RV101" Then
DTPicker1.Value = "07:45:00"
DTPicker2.Value = "15:15:00"
ElseIf ComboBox1.Value = "RV102" Then
DTPicker1.Value = "07:45:00"
DTPicker2.Value = "11:15:00"
ElseIf ComboBox1.Value = "DL001" Then
DTPicker1.Value = "07:00:00"
DTPicker2.Value = "15:30:00"
ElseIf ComboBox1.Value = "GV001" Then
DTPicker1.Value = "08:30:00"
DTPicker2.Value = "17:00:00"
ElseIf ComboBox1.Value = "AV001" Then
DTPicker1.Value = "07:00:00"
DTPicker2.Value = "15:30:00"
ElseIf ComboBox1.Value = "AV002" Then
DTPicker1.Value = "09:00:00"
DTPicker2.Value = "17:30:00"
ElseIf ComboBox1.Value = "PR001" Then
DTPicker1.Value = "06:30:00"
DTPicker2.Value = "15:30:00"
ElseIf ComboBox1.Value = "PR002" Then
DTPicker1.Value = "08:00:00"
DTPicker2.Value = "17:00:00"
ElseIf ComboBox1.Value = "RN001" Then
DTPicker1.Value = "22:00:00"
DTPicker2.Value = "06:00:00"
ElseIf ComboBox1.Value = "PR1" Then
DTPicker1.Value = "09:00:00"
DTPicker2.Value = "17:30:00"
ElseIf ComboBox1.Value = "PR4" Then
DTPicker1.Value = "07:00:00"
DTPicker2.Value = "16:00:00"
ElseIf ComboBox1.Value = "APDIENST" Then
MsgBox ("Je hebt een aangepaste dienst ingevuld." & vbCrLf & _
"Vul hieronder de juist gewerkte tijden in." & vbCrLf & "En vul daaronder in of je de uren aangevuld wilt hebben, " & vbCrLf & _
"J=8, J1=8,5, J2=6, dit geldt ook voor bijzonderverlof"), vbExclamation, "Invullen!"
DTPicker1.Enabled = True
DTPicker2.Enabled = True
ElseIf ComboBox1.Value = "Verlof" Then
MsgBox ("Vul in het onderste vakje het verlof in: " & vbCrLf & _
"V1=8 uur, V2=8,5 uur en V3=6 uur verlof"), vbInformation, "Verlofinvullen"
DTPicker1.Value = "00:00:00"
DTPicker2.Value = "00:00:00"
ElseIf ComboBox1.Value = "Ziek" Then
MsgBox ("Vul in het onderste vakje de ziekte uren in: " & vbCrLf & _
"Z=8, Z1=8,5 en Z2=6 uur ziek"), vbInformation, "Ziektediensten"
DTPicker1.Value = "00:00:00"
DTPicker2.Value = "00:00:00"
ElseIf ComboBox1.Value = "TAXI" Then
MsgBox ("Vul in het onderste vakje de taxi uren in: " & vbCrLf & _
"Er wordt standaard 30 min pauze afgehaald, is dit meer geweest graag melden!!!!" & vbCrLf & _
"Als je niet aan 8 uur komt, ook graag aanvullen met verlof invullen!"), vbInformation, "Taxidiensten"
DTPicker1.Enabled = True
DTPicker2.Enabled = True
Else
DTPicker1.Value = "00:00:00"
DTPicker2.Value = "00:00:00"
End If

Deze code staat er in totaal 7x in.

Als er dus een wijziging is qua diensttijden of van rooster moet ik alles dus 7x aanpassen.
Dit geldt dus ook voor de dtpickers.


Is er misschien een mogelijkheid om deze code (flink) in te korten met "dim" of iets dergelijks?

Ik hoop dat mijn uitleg duidelijk genoeg is, zo niet hoor ik het wel.

Alvast bedankt voor het meedenken!

 

[edmoor]

Ik zou al die verschillende gegevens die je nodig hebt in een (verborgen) blad van het document eenmalig invoeren. Dan hoef je ook maar 1x een wijziging door te voeren wanneer dat nodig is. In de Subs gebruik je dan de waarden uit dat blad. Daarnaast zou ik die hele If..Then..ElseIf..End IF structuur wijzigen in een Select..Case..End Select structuur.

 

[MEradus]

Bedankt voor je reactie,

Ik zal in ieder geval even opzoek gaan naar de "Select" structuur, want daar ben ik helemaal nog niet mee bekend.

 

[edmoor]

Daar wordt het niet veel korter van maar wel gestructureerder en daardoor beter leesbaar. Het belangrijkste is het blad met de vaste gegevens. Dan heb je die gegevens buiten de code en hoef je ze maar 1x in te voeren.

 

[MEradus]

In je eerste reactie heb je het over die verborgen tabblad, bedoel je daarmee dat ik met die informatie de combobox moet vullen?
Dat zou betekenen (als ik je goed begrijp) dat ik de hele code moet aanpassen naar deze voorbeeld code?

If ComboBox1.Value = "DV001" Then
DTPicker1.Value = "Worksheet("Verborgen").range("A3").value"
DTPicker2.Value = "Worksheet("Verborgen").range("A4").value"

Alvast weer bedankt voor je reactie.

 

[edmoor]

Zoiets ja. Maar ik zou dan met benoemde bereiken gaan werken. Dan komt het er bijvoorbeeld zo uit te zien:

Select Case ComboBox1.Value
    Case "DV001"
        DTPicker1.Value = Range("DV001_1")
        DTPicker2.Value = Range("DV001_2")
    Case "DV002"
        DTPicker1.Value = Range("DV002_1")
        DTPicker2.Value = Range("DV002_2")
End Select

Dat is alweer een stuk leesbaarder en het geeft je de vrijheid om de benoemde bereiken in het werkboek of werkblad te verplaatsen, mocht dat nodig zijn, zonder dat je de code moet aanpassen.
Een bereik kan dan zelfs naderhand uit meer dan 1 cel bestaan als dat handig blijkt te zijn, met maar een geringe aanpassing aan de code.

 

[MEradus]

Bedankt, ik ga hier mee aan de slag!

 

[snb]

Ik zou toch maar een bestandje plaatsen.
Dit kan zooooveel eeenvoudiger; zie de bijlage. In plaats van 2 datepickers worden in het voorbeeld 2 tekstvakken gebruikt. De functionalitiet is dezelfde. 3 regels code kunnen die van jou vervangen.


Waarom kunnen geen xlsb bestanden geplaatst worden ????

 

[MEradus]

Graag

Hoi Snb,

Bedankt dat je ook gereageerd hebt op mijn vraag.

Ik heb het bestand toch maar even aangepast zodat je een voorbeeld hebt.
Het zou heel gaaf zijn als het makkelijker zou kunnen, vooral omdat ik komende maanden weer veel wijzigingen moet doorvoeren

Het bestand bleek te groot te zijn voor de normale upload, ook nadat ik wat dingetjes verwijderd had. Dus dan maar even via een link.

Bestandje

Ik hoop dat het lukt!

(P.s. Ik ben ook al eens op jouw website geweest ivm codes voor het versturen van email (deze code staat ook in dit bestandje). Bedankt daarvoor!.
Ik weet niet of het mag (nog een vraag stellen binnen een vraag) Maar is er ook een (makkelijke) code om het 'toestaan' voor verzenden dialoog te omzeilen? Ik heb al eens gezocht, maar kan geen code vinden.
En programma's installeren mag hier niet op de server van mij werk. ) ( als dit niet mag, mag dit stukje genegeerd worden)

 

[edmoor]

Wat je vraag over mailen betreft, dat is een beveiliging van de Exchange server. Daarvoor moet de beheerder dan een SMTP connector aanmaken met daarin de IP adressen die Exchange als SMTP server mogen gebruiken.
Daarnaast kun je bijvoorbeeld de SMTP server van Gmail gebruiken om mail te sturen zodat je die Exchange server er niet voor nodig hebt. Dan kan door CDO in te zetten en hoe dat werkt is al eens prima beschreven door Ron de Bruin:
http://www.rondebruin.nl/win/s1/cdo.htm

 

[MEradus]

Bedankt! Ga ik even doorlezen!

 

[snb]

Kijk eens naar het bestand dat ik in #8 plaatste.

 

[MEradus]

Ga ik doen! Thx!

 

[MEradus]

Hoi Snb,

Ik ben even bezig met het bestandje van jou, dit werkt echt super.
Toch heb ik even een vraag, zou het ook mogelijk zijn om de waarde in een DTPicker te zetten ipv een textbox?

 

[MEradus]

Hoi Snb,

Ik heb net in jouw bestandje de "DTPicker" getest, en dit werkt ook.

Maar ik krijg als ik de boel aanpas in mijn eigenbastand een "Fout 70, Toegang geweigerd"

Hoe kan ik deze oplossen?

Alvast bedankt voor je hulp!

 

[snb]

Je kunt ook mijn bestand als uitgangspunt nemen en daar de ontbrekende code uit jouw bestand inzetten.

 

[MEradus]

Hoi SNB ( of iemand anders die toevallig meeleest.

Ik heb nog even een vraag.
Is het ook mogelijk om een de waarde uit de (combobox).list als enige waarde te maken die men kan invoeren?

Het wil nu gebeuren dat mijn collega's de teksten/waarden in de combobox zelf aanpassen, waardoor de uitkomst niet meer goed is.

Alvast bedankt voor je reactie!!

 

[snb]

gebruik de eigenschap .style , waarde 2-dropdownlist

 

[MEradus]

Bedankt! Werkt perfect!