Msgbox

Leotaxi · 30 mei 2015

Beste helpers,

heb in code hieronder een vraag aan de gebruiker of er verder gegaan moet worden,
er kan dus gekozen worden voor OK of Cancel.
Bij beide antwoorden wordt code wel uitgevoerd zoals zou moeten, maar de Msgbox
komt terug, pas na 2 de maal antwoorden verdwijnt deze.
Waar zie ik weeral overheen ? iemand idee ?

Code:

antw = MsgBox("Van " & dags & " " & dats & Chr(13) & Chr(13) & "Tot " & dage & " " & daten & Chr(13) _
& Chr(13) & "Aanmaken ?", vbOKCancel)

If antw = vbCancel Then
    MsgBox "bewerking werd afgebroken"
    GoTo eind
End If
If antw = vbOK Then

Fragment van hierboven komt uit:

Code:

Private Sub Txtjaare_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dags As String, dage As String, dats As Date, daten As Date, antw As Integer

dags = Format(Me.Txtdags & "/" & Me.Txtmaands & "/" & Me.Txtjaars, "dddd")
dage = Format(Me.Txtdage & "/" & Me.Txtmaande & "/" & Me.Txtjaare, "dddd")
dats = Format(Me.Txtdags & "/" & Me.Txtmaands & "/" & Me.Txtjaars, "dd-mm-yyyy")
daten = Format(Me.Txtdage & "/" & Me.Txtmaande & "/" & Me.Txtjaare, "dd-mm-yyyy")

antw = MsgBox("Van " & dags & " " & dats & Chr(13) & Chr(13) & "Tot " & dage & " " & daten & Chr(13) _
& Chr(13) & "Aanmaken ?", vbOKCancel)

If antw = vbCancel Then
    MsgBox "bewerking werd afgebroken"
    GoTo eind
End If
If antw = vbOK Then
    Dim dat As Date, datVD As Date, naamM As String, naamD As String, naamJ As String, naamDvd As String, _
    naamMvd As String, naamJvd As String, lastrow As Long, kolom As Integer, kolom2 As Integer, _
    lastrow2 As Long, kol, kol2, onp, wk, wk2
    i = 0
    dat = dats + i
    datVD = dat - 1
    naamD = Day(dat) & "-" & Month(dat) & "-" & Right(Year(dat), 2)
    naamM = Month(dat) & "-" & Right(Year(dat), 2)
    naamJ = Year(dat)
    naamDvd = Day(datVD) & "-" & Month(datVD) & "-" & Right(Year(datVD), 2)
    naamMvd = Month(datVD) & "-" & Right(Year(datVD), 2)
    naamJvd = Year(datVD)
    kolom = Day(dat) + 1
    kolom2 = Day(datVD) + 1

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
Sheets("Dagplanning").Range("a3", "c502").ClearContents
Sheets("Dagplanning").Range("s3", "u502").ClearContents

'controle of dag al niet is gemaakt
    Set rFoundCell = Sheets("Dagen").Range("a1")
    Set rFoundCell = Sheets("Dagen").Columns(1).Find(What:=naamD, after:=rFoundCell, _
    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)
    If Not rFoundCell Is Nothing Then
        MsgBox "Deze dag is al aangemaakt"
        GoTo eind
    End If
'controle of maand al aangemaakt is
    Set rFoundCell = Sheets("Maanden").Range("a1")
    Set rFoundCell = Sheets("Maanden").Columns(1).Find(What:=naamM, after:=rFoundCell, _
    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)
    If rFoundCell Is Nothing Then
        MsgBox "Deze maand is nog niet aangemaakt"
        Exit Sub
    End If
' weeknummers en controle op even of oneven weken
    wk = DatePart("ww", dat - Weekday(dat, 2) + 4, 2, 2)
    wk2 = DatePart("ww", datVD - Weekday(datVD, 2) + 4, 2, 2)
    onp = wk Mod 2 + 1
'blad aanmaken voor gekozen dag
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = naamD
'kolomnummers begin en einduur huidige en vorige dag
    If onp = 1 Then
        kol = Choose(Weekday(dat, 2), 24, 27, 30, 33, 36, 39, 42)
        kol2 = Choose(Weekday(datVD, 2), 24, 27, 30, 33, 36, 39, 20)
    Else
        kol = Choose(Weekday(dat, 2), 2, 5, 8, 11, 14, 17, 20)
        kol2 = Choose(Weekday(datVD, 2), 2, 5, 8, 11, 14, 17, 42)
    End If
' maand uit jaarmap ophalen
    Workbooks.Open (ThisWorkbook.Path & "\" & naamJ & ".xlsx")
    Sheets(naamM).Move before:=Workbooks("bezettingsrooster.xlsm").Sheets(1)
' Namen en uren plaatsen
    lastrow = Sheets(naamM).Range("a" & Rows.Count).End(xlUp).row
    For a = 3 To lastrow
         If Sheets(naamM).Cells(a, kolom).Value = "W" Then
                Sheets("Dagplanning").Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets(naamM).Cells(a, 1).Value
                Sheets("dagplanning").Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("Uurrooster").Cells(a + 1, kol).Value
                Sheets("dagplanning").Range("c" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("Uurrooster").Cells(a + 1, kol + 1).Value
         End If
    Next
' namen en uren vorige dag
    If Month(dat) = Month(datVD) Then
        naamMvd = naamM
    End If
    If Month(dat) <> Month(datVD) Then
        Workbooks(naamJ).Activate
        Sheets(naamMvd).Move before:=Workbooks("bezettingsrooster.xlsm").Sheets(1)
        Workbooks("bezettingsrooster").Activate
    End If
    lastrow = Sheets(naamMvd).Range("a" & Rows.Count).End(xlUp).row
    For a = 3 To lastrow
        If Sheets(naamMvd).Cells(a, kolom2).Value = "W" Then
                Sheets("Dagplanning").Range("s" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets(naamMvd).Cells(a, 1).Value
                Sheets("dagplanning").Range("t" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("Uurrooster").Cells(a + 1, kol2).Value
                Sheets("dagplanning").Range("u" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("Uurrooster").Cells(a + 1, kol2 + 1).Value
        End If
    Next
'datum op dag en gegevens naar eigen blad
    Sheets("Dagplanning").Range("a1") = dat
    Sheets("Dagplanning").Range("s1") = datVD
    Sheets(naamD).Range("Z3").Value = Sheets("Dagplanning").Range("Z3")
    zzz = Sheets("dagplanning").Range("a" & Rows.Count).End(xlUp).row
    Sheets("Dagplanning").Range("a1", "c" & zzz).Copy Destination:=Sheets(naamD).Range("a1")
    Sheets(naamD).Range("a1").ColumnWidth = 30
    Sheets("Dagplanning").Columns("E:L").Copy Destination:=Sheets(naamD).Range("e1")
'formules van aangemaakte dag verwijderen
    Sheets(naamD).Range("F4", "F30").Value = Sheets(naamD).Range("F4", "F30").Value
    Sheets(naamD).Range("H4", "H30").Value = Sheets(naamD).Range("H4", "H30").Value
    Sheets(naamD).Range("J4", "J30").Value = Sheets(naamD).Range("J4", "J30").Value
    Sheets(naamD).Range("L4", "L30").Value = Sheets(naamD).Range("L4", "L30").Value
    Sheets(naamD).Range("Z3").Value = ""
'sorteren van vroeg tot laat
    With Range("a3", "c304")
    ActiveWorkbook.Worksheets(naamD).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(naamD).Sort.SortFields.Add Key:=Range("B2:B300") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    End With
    With ActiveWorkbook.Worksheets(naamD).Sort
        .SetRange Range("A3:C300")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'markeren dat dag is aangemaakt en nog niet verwerkt
    Sheets("dagen").Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Value = "'" & naamD
    Sheets("dagen").Range("a" & Rows.Count).End(xlUp).Offset(0, 1).Value = "Nee"

'blad maand en aangemaakte dag naar jaarmap, en jaarmap sluiten
    Sheets(naamD).Move before:=Workbooks(naamJ & ".xlsx").Sheets(1)
    Workbooks("bezettingsrooster").Sheets(naamM).Move before:=Workbooks(naamJ & ".xlsx").Sheets(1)
    If Month(dat) <> Month(datVD) Then
        Workbooks("bezettingsrooster").Sheets(naamMvd).Move before:=Workbooks(naamJ & ".xlsx").Sheets(1)
    End If
    Workbooks(naamJ & ".xlsx").Close True
    
eind:
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Unload Me
End Sub

alle hulp welkom
mvg
Leo

edmoor · 30 mei 2015

De If antw = vbOK Then is totaal overbodig. Daarnaast staat het label Eind: binnen deze If en dat levert een probleem op. Hier geldt zoals overal, NOOIT een Goto gebruiken anders dan naar het echte einde van een routine.

Los daar van:
Kijk ook eens naar hoe het With statement moet worden gebruikt. Je hebt nu overbodig veel code en in onlogische volgorde.

Leotaxi · 31 mei 2015

Edmoor,

wat ik ook wijzig en of weghaal, toch blijf de vraag steeds een tweede keer terugkomen.

Heb het anders opgelost,
bij verlaten laatste textbox komt de nu vraag om verder te gaan in caption van userform
en op het userform natuurlijk de knoppen ok en cancel.

alles werkt perfect nu, rest mij enkel nog het vereenvoudigen.

mvg
Leo

edmoor · 31 mei 2015

Hoi Leo,

Als je dat document hier plaatst wil ik best even mee kijken.

Leotaxi · 31 mei 2015

Dag Edmoor,

ook na comprimeren te groot maar heb hem hier gezet

http://www.filedropper.com/bezettingsrooster

de vraag hierboven kwam van onderdeeltje dagplanning

mvg
Leo

Leotaxi · 31 mei 2015

en deze wordt ook gebruikt

mvg
Leo

edmoor · 31 mei 2015

En welke van de twee betreft het probleem zoals beschreven in #1?

Leotaxi · 31 mei 2015

Is in bezettingsrooster, in menu kiezen voor dagplanning
daar komt nieuw userform voor ingave datums, nu staat er aangepaste code achter button OK

In post #1 stond code uit post #1 bij exit textbox Txtjaare

mvg
Leo

edmoor · 31 mei 2015

Ik heb de code ervan bekeken en het is inderdaad al anders dan in #1. Toch heb ik voor verhoging van de leesbaarheid nog wat dingen aangepast en de Goto eruit gehaald. Voor het springen naar het einde van een Sub is dat geen probleem maar ik zie ze liever niet en het kan ook anders.

Ik kan het echter niet controleren vanwege het ontbreken van een bibliotheek die je gebruikt, maar dat kan je zelf wel. Bekijk de code eens. Naar mijn mening is het zo een heel stuk leesbaarder en dus eenvoudiger te volgen.
http://www.filedropper.com/bezettingsrooster_1

Leotaxi · 31 mei 2015

Edmoor,

werkt Perfect :thumb:
vele dank

mvg
Leo

edmoor · 31 mei 2015

Ok dan. En graag gedaan

Msgbox

Leotaxi

Verenigingslid

edmoor

Inventaris

Leotaxi

Verenigingslid

edmoor

Inventaris

Leotaxi

Verenigingslid

Leotaxi

Verenigingslid

Bijlagen

edmoor

Inventaris

Leotaxi

Verenigingslid

edmoor

Inventaris

Leotaxi

Verenigingslid

edmoor

Inventaris

Nieuwste berichten

Wij waarderen jouw privacy