maand en jaar aanpassen via vba code

Plainme · #1 4 februari 2012, 21:05

Hallo forumvrienden

iemand een idee hoe je via een popupscherm kan vragen of de maand en jaar dient te worden aangepast en dit bijvoegen aan bestaande code?

in bijlage ziet men het duidelijker
de cellen waarop de vraag slaat is gemarkeerd in het rood.
hierbij alvast de code

Sub NieuweBestelbonKnop_Klikken()
If MsgBox("Een nieuwe Bestelbon zal worden aangemaakt!" & vbCrLf & vbCrLf & "Doorgaan?", vbYesNo + vbInformation, "Bevestiging Nieuwe Bestelbon") = vbYes Then
Dim oldMonth As String
Dim oldYear As Integer
Dim newMonth As String
Dim newYear As Integer
'
Dim months(11) As String
months(0) = "Januari"
months(1) = "Februari"
months(2) = "Maart"
months(3) = "April"
months(4) = "Mei"
months(5) = "Juni"
months(6) = "Juli"
months(7) = "Augustus"
months(8) = "September"
months(9) = "Oktober"
months(10) = "November"
months(11) = "December"
'
' opvullen
oldMonth = Range("R22")
oldYear = Range("T22")
MsgBox (oldMonth & " " & oldYear)
'
Dim index As Integer
index = 0
Do Until months(index) = oldMonth
index = index + 1
If index = 12 Then Exit Do
Loop
If index = 12 Then
MsgBox "Huidig werkblad bevat een ongeldige datum! Er wordt geen copy genomen.", vbOKOnly + vbCritical, "Fout bij Datum"
Else
If index = 11 Then
newMonth = months(0)
newYear = oldYear + 1
Else
newMonth = months(index + 1)
newYear = oldYear
End If
'MsgBox (newMonth & " " & newYear)
' oude BBnr opvragen
Dim oudeBBNr As Integer
oudeBBNr = CInt(Range("M22").Value)
' oude sheetname opvragen en in variabele stockeren
Dim activeSheetName As String
activeSheetName = ActiveWorkbook.ActiveSheet.Name
'MsgBox (oudeBBNr & " ")
' copy nemen van actieve blad naar nieuw blad (invoegen voor blad opmeting)
ActiveWorkbook.ActiveSheet.Copy Before:=ActiveWorkbook.Sheets("Opmeting")
'
' naam instellen van gekopieerde blad
Dim nummerRechtsVanSpatie As String
nummerRechtsVanSpatie = Mid(activeSheetName, 10, Len(activeSheetName) - 9)
Dim nummer As Integer
nummer = CInt(nummerRechtsVanSpatie)
Sheets(activeSheetName & " (2)").Name = "Bestelbon " & nummer + 1
'
Range("R22") = newMonth
Range("T22") = newYear
Range("M22") = Format(oudeBBNr + 1, "000")
End If
End If
End Sub

Sorry dat het in rar is maar kreeg het niet kleiner dan 231kb zelfs wanneer leeg!!!

raar maar misschien gelijk een tweede vraagje :)
iemand enig idee reden???
alvast bedankt en bij vragen hoor ik deze graag

grts
Marc

bsalv · #2 5 februari 2012, 00:24

misschien wordt het hierdoor eenvoudiger ?

Code:

Sub NieuweBestelbonKnop_Klikken()
  If MsgBox("Een nieuwe Bestelbon zal worden aangemaakt!" & vbCrLf & vbCrLf & "Doorgaan?", vbYesNo + vbInformation, "Bevestiging Nieuwe Bestelbon") = vbYes Then

    On Error Resume Next
    datum = DateValue("1 " & Range("P22").Value & " " & Range("R22").Value)  'maak een datum van je 2 cellen
    On Error GoTo 0
    If datum = 0 Then MsgBox "foute datum !!!!" & vbLf & "volgende keer beter":exit sub  'is het wel een datum ?
    nieuwedatum = DateSerial(Year(datum), Month(datum) + 1, 1)  'volgende maand
    Range("P22").Value = WorksheetFunction.Text(nieuwedatum, "[$-813]mmmm")  'maand wegschrijven
    Range("R22").Value = Year(nieuwedatum)                 'jaar wegschrijven
.....

Plainme · #3 5 februari 2012, 10:46

Bsalv,

Heb je code er in gezet maar dan klopt het helemaal niet meer.
krijg dan gewoon 2 jaartallen! is niet de bedoeling.
bedoeling : vragen of de maand en eventueel jaar ( december > januari) dient te worden aangepast? er kunnen meerdere bestellingen in de zelfde maand geplaatst worden. ( zelfs in de zelfde dag :) )

grts
Marc

bsalv · #4 5 februari 2012, 12:41

de adressen van de cellen in je macro en de rode cellen in je voorbeeld werkblad kwamen niet overeen, dus kijk daar eerst even naar.

Plainme · #5 5 februari 2012, 13:00

is opgelost, maar hierbij past deze nog steeds de maand aan (+1) terwijl er de vraag dient te worden gesteld of de maand dient te worden verhoogd of niet.
enkel de waarde in cel O22 dient dan te worden verhoogd.
(#N/B omwille verwijderd van gevoelige info.)

Hierbij het voorbeeld waarvoor het eigenlijk dient.

mvg,
Marc

Citaat:

Oorspronkelijk geplaatst door bsalv

de adressen van de cellen in je macro en de rode cellen in je voorbeeld werkblad kwamen niet overeen, dus kijk daar eerst even naar.

bsalv · #6 5 februari 2012, 15:00

als in O22, R22 en T22 de dag, de maand en het jaartal staan, dan ...

Code:

Sub NieuweBestelbonKnop_Klikken()
  Dim NieuweDatum As Date, Datum As Date, bOK As Boolean
  On Error Resume Next
  Datum = DateValue(Range("O22").Value & " " & Range("R22").Value & " " & Range("T22").Value)  'maak een datum van je 2 cellen
  On Error GoTo 0
  If Datum = 0 Then MsgBox "foute datum in 022 R22 T22 !!!!" & vbLf & "volgende keer beter": Exit Sub  'is het wel een datum ?
  NieuweDatum = Datum
  Do
    NieuweDatum = NieuweDatum + 1                          'volgende dag kiezen
    bOK = (Weekday(NieuweDatum, 1) <= 5)                   'nieuwe datum mag bv. geen zaterdag of zondag zijn
  Loop While Not bOK

  Range("O22").Value = Day(NieuweDatum)
  Range("R22").Value = WorksheetFunction.Text(NieuweDatum, "[$-813]mmmm")  'maand wegschrijven
  Range("T22").Value = Year(NieuweDatum)                   'jaar wegschrijven
End Sub

snb · #7 5 februari 2012, 21:07

@BSALV

Waarom niet:

Code:

 
if isdate(Range("O22").Value & "-" & Range("R22").Value & "-" & Range("T22").Value) then  ....

bsalv · #8 6 februari 2012, 08:03

je hebt gelijk !!

Code:

Sub NieuweBestelbonKnop_Klikken()
  Dim NieuweDatum As Date, bOK As Boolean, s As String
  s = Range("O22").Value & "-" & Range("R22").Value & "-" & Range("T22").Value
  If Not IsDate(s) Then                                    'maak een datum van je 2 cellen
    MsgBox "foute datum in 022 R22 T22 !!!!" & vbLf & "volgende keer beter": Exit Sub  'is het wel een datum ?
  Else
    NieuweDatum = DateValue(s)
    Do
      NieuweDatum = NieuweDatum + 1                        'volgende dag kiezen
      bOK = (Weekday(NieuweDatum, 1) <= 5)                 'nieuwe datum mag bv. geen zaterdag of zondag zijn
    Loop While Not bOK
    Range("O22").Value = Day(NieuweDatum)
    Range("R22").Value = WorksheetFunction.Text(NieuweDatum, "[$-813]mmmm")  'maand wegschrijven
    Range("T22").Value = Year(NieuweDatum)                 'jaar wegschrijven
  End If
End Sub

snb · #9 6 februari 2012, 09:45

en ?

Code:

NieuweDatum = DateValue(s)+1 +2*(weekday(datevalue(s),2)\5)
 
Range("O22").Value = Day(NieuweDatum)
Range("R22").Value = format(NieuweDatum, "mmmm")
Range("T22").Value = Year(NieuweDatum)

bsalv · #10 6 februari 2012, 12:10

dat van die zaterdag en zondag had ik er zelf bij gedacht, want ik weet niet of TS die wel wilde hebben en of er ook geen andere vw in het spel komen.
maar anders is het wel een beknoptere versie

Discussietools
Printversie tonen Deze pagina e-mailen
Weergave
Lineaire weergave Switchen naar hybride weergave Switchen naar vertakte weergave

Soortgelijke discussies
Discussie	Auteur	Forum	Reacties	Laatste bericht
verbruik per maand en per jaar	tjarda	Afgehandelde vragen	6	29 februari 2012 18:47
Berekenen verbruik van een bepaalde code per jaar-maand	Luap	Afgehandelde vragen	5	15 augustus 2011 20:42
totalen per maand ook per jaar	williamtell	Afgehandelde vragen	2	30 december 2009 18:27
Maand, Jaar en SumIf problemen...	WPHU	Afgehandelde vragen	3	2 april 2007 17:07
Jaartallen sorteren op dag, maand en jaar etc	Klaas	Afgehandelde vragen	7	24 februari 2006 23:16