IF-THEN op basis van maandherkenning (VBA Word)

[alexanderinfo]

Hallo,

Ik heb een userform gemaakt die helpt een formulier in te vullen.
Omdat heel veel mensen niet de moeite nemen om het formulier op te slaan, wil ik middels VBA het formulier automatisch onder een bepaalde naam opslaan.
Het probleem is echter dat er 12 mappen zijn (elk een maand).
En het formulier moet in de juiste map opgeslagen worden afhankelijk van de betreffende maand.
Omdat ik geen zin heb om elke maand een deel van het script aan te passen hoop ik dus iemand te vinden die mij kan helpen met een formule die de maand kan herkennen (deze wordt ingevuld in 1 van de textboxen - txtMijnDatum).


ik heb het zelf geprobeerd met:

If txtMyDate.Value = MonthName(4, True) Then

Om aan te geven dat indien de maand vernoemd in txtMyDate april is, dan moet de code dus werken.
Dit werkt helaas ook niet.


gr.

Alexander

 

[snb]

c01=month(textbox1.txt)

 

[alexanderinfo]

Waar staat de c01 voor?
Want met een if-then opdracht werkt het niet.

 

[alexanderinfo]

Is er misschien iemand anders die een oplossing heeft?

 

[OctaFish]

c01 is de naam van een variabele. De formule rekent de maandwaarde uit, dus 3 voor maart en 4 voor april.
Je geeft verder niet echt aan hoe je het document opslaat, dus dat wordt lastig gokken...

 

[Mark xl]

Bedoel je zoiets:

Sub SlaBestandOp()
    
    Dim maand As Long

    On Error GoTo Mislukt:
    
    maand = MaandNummer(txtMyDate)
    
    ThisWorkbook.SaveAs "C:\temp\somefile" & maand & ".xlsm", xlOpenXMLWorkbookMacroEnabled
    
Mislukt:

    If Err.Number <> 0 Then
    
        MsgBox "fout : " & Err.Description
        txtMyDate.SetFocus
    
    End If

End Sub

Function MaandNummer(maand As String) As Long

    Dim i As Long

    For i = 1 To 12
        
        If LCase(maand) = LCase(MonthName(i)) Then
            MaandNummer = i
            Exit Function
        End If
            
    Next
     
    Err.Raise vbObjectError + 1, "MaandNummer", "De opgegeven maand (" & maand & ") is niet bekend"

End Function

 

[alexanderinfo]

Mark en octafish,

bedankt voor jullie antwoorden.

wat ik probeer te krijgen is:

de gebruiker druk op de eindknop.
daarna wordt het formulier ingevuld met de variabele data en moet het formulier automatisch opgeslagen worden.
die code is al geregeld, alleen moet de maand herkend worden en daarna op basis van de maandherkenning in een bepaalde map worden opgeslagen.

de code moet dus inhoudelijk iets hebben van "IF txtMyDate is gelijk aan april THEN"........enz enz (hier gaat de opslagcode werken)
txtMyDate is overigens ingevuld als format dddd mm yyyy


Mijn huidige code voor het opslaan is nu:

ChangeFileOpenDirectory _
    "K:\04 April\"
ActiveDocument.SaveAs FileName:= _
    "K:\04 April\" & txtAchternaam.Value & ".docx" _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False

deze werkt prima wat het opslaan betreft. alleen slaat hij nu altijd op in de maandmap van april en dus moet ik hem handmatig straks veranderen als de maand april voorbij is.

ik heb trouwens

if c04=Monthh(txtMyDate.text) then

gebruikt, maar dan krijg ik de compileerfout: Sub of Function is niet gedefinieerd.


ps. Mark, het betreft hier een word bestand. geen excel.

 

[snb]

  activeDocument.SaveAs "K:\" & format(date,"mm mmm\\") & txtAchternaam.Value & ".docx"

 

[Mark xl]

ps. Mark, het betreft hier een word bestand. geen excel.

Sorry, ik had Excel openstaan.

wat je zoekt is wat snb heeft gepost maar dan wél rekening houdende met je vraag om de datum uit je textbox te gebruiken.

datum formaat dddd mm yyyy zou betekenen "thursday april 2011", en dat is ongebruikelijk. Kun je iets specifieker zijn wat de exacte datumnotatie is, dan kunnen we je beter helpen..

omdat txtDatum geen datum is maar tekst, is het niet direct om te zetten naar een datum, want datum herkenning op basis van tekst is systeem afhankelijk, en dus onbetrouwbaar. je zal iets van een decodeer functie moeten toevoegen om je "tekst datum" te converteren naar een Date. daarna kun je het mooie stukje code van snb gebruiken.

Mark.

Edit: hier een voorbeeld proc met de code van snb

'datumnotatie: [dag] [maand] [jaar]
Private Enum dsDatePart
    dsDay
    dsMonth
    dsYear
End Enum

'datum notatie volgorde zie Enumeratie dsDatePart
Function ConvertDate(ByVal text As String) As Date

    'het datum scheidingsteken
    Const DATE_SEPARATOR As String = " "

    Dim a() As String
    Dim yr As Long
    
    '3 datumdelen splitsen
    a = Split(text, DATE_SEPARATOR)
    'jaar notatie yy of yyyy afvangen
    yr = (a(dsYear) Mod 100) + 2000
                    
    On Error Resume Next
    ConvertDate = CDate(yr & "-" & a(dsMonth) & "-" & a(dsDay))
    
    If Err.Number <> 0 Then
        
        On Error GoTo 0 'onderdruk standaard "Type-mismatch" en roep alternatieve fout op
        Err.Raise vbObjectError + 99, "ConvertDate", "De opgegeven datumnotatie wordt niet herkend"
    
    End If

End Function

Sub SaveProc()
    On Error GoTo ErrHandler
    activeDocument.SaveAs "K:\" & Format(ConvertDate(txtDate.Value), "mm mmm\\") & txtAchternaam.Value & ".docx"
ErrHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation
    End If
End Sub

 

[alexanderinfo]

ik had in mijn haast inderdaad de format verkeerd genoteerd.
het correcte format dat ik gebruik is "dd mmmm yyyy".

het staat mooier en geeft de gebruiker meer duidelijkheid om welke dag het gaat, maar ik kan ook de datum "d-mm-yy" wegschrijven.
dat maakt voor het eindresultaat niet uit. als dat nodig is om een decodeer functie te voorkomen, is dat ook prima.

ik ga iig even met de bovenstaande code stoeien en kijken of het lukt.

alvast bedankt mensen....

 

[alexanderinfo]

mark,

ik krijg hem helaas niet aan de praat met jouw code.
Als ik gewoon een cijfernotatie gebruik (bv. 04-04-12), is er dan een simpele IF...THEN oplossing?

 

[Mark xl]

Als ik gewoon een cijfernotatie gebruik (bv. 04-04-12), is er dan een simpele IF...THEN oplossing?

Nee, een tekst blijft tekst todat je systeem het als datum herkent. en als je systeem toevallig je tekst als datum herkent dan is dat afhankelijk van je lokale instellingen op dat moment.

Wat gaat er mis met de code? misschien kan ik het oplossen. Of heb je een voorbeeld bestandje. ..?

 

[alexanderinfo]

Private Sub cmdOk_Click()
Application.ScreenUpdating = True
With ActiveDocument

txtMyDate = Format(Date, "dd mmmm yyyy")

ActiveDocument.SaveAs "K:\04 April\" & "Voorgeleidingsformulier " & txtAchternaam.Value & ".doc"
ActiveDocument.PrintOut

End With
    Application.ScreenUpdating = True
    Unload Me
    MsgBox ("Uw formulier is opgeslagen in de daarvoor bestemde map en het formulier wordt nu uitgeprint.")

end sub

Dit is eigenlijk het kleine stukje code dat voor problemen zorgt.
Nu is er geen IF...THEN en wordt het formulier altijd opgeslagen in de map 04 april (ook al is de datum straks mei).

 

[Mark xl]

Dan moet je deze code gebruiken:

  activeDocument.SaveAs "K:\" & format(date,"mm mmm\\") & txtAchternaam.Value & ".docx"

omdat je txtdatum vult met de datum van vandaag is conversie inderdaad niet nodig.

ik heb de code van snb toegevoegd in een iets uitgebreider versie van jouw macro, met een door jou gewenste "IF THEN" zodat je een map kan aanmaken als de maand voorbij is voor de volgende maand. hopelijk is dit een beetje wat je wilt.

Private Sub cmdOk_Click()
    
    Dim maandPath As String
    Dim keuze As VbMsgBoxResult

    maandPath = "K:\" & Format(Date, "mm mmmm\\")

    If Dir(maandPath, vbDirectory) = vbNullString Then

        keuze = MsgBox("De map " & maandPath & " bestaat nog niet. wilt u deze aanmaken?", _
                    vbYesNo, vbQuestion)

        If keuze <> vbYes Then
            MsgBox "Bestand NIET opgeslagen!", vbInformation
            Exit Sub
        End If
        
        On Error GoTo ErrorEinde
        MkDir maandPath

    End If

    Application.ScreenUpdating = False

    With ActiveDocument
        .SaveAs "K:\" & Format(Date, "mm mmmm\\") & txtAchternaam.Value & ".docx"
        .PrintOut
    End With

    Application.ScreenUpdating = True

    'Unload Me
    MsgBox ("Uw formulier is opgeslagen in de daarvoor bestemde map en het formulier wordt nu uitgeprint.")
    Exit Sub

ErrorEinde:
    MsgBox Err.Description & vbNewLine & "Bestand NIET opgeslagen!", vbInformation

End Sub

 

[alexanderinfo]

Mark you rule!!!!


ik heb je code een klein beetje aangepast zodat hij niet de datum van vandaag gebruikt, maar de datum opgegeven in de textbox en hij werkt voortreffelijk.
mijn dank is groot. je hebt me enorm geholpen.


gr.

alexander