• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

gegevens uit formulier voor vezenden naar centraal document exporteren via VBA

Status
Niet open voor verdere reacties.
R

rkootje

Gebruiker
Lid geworden
24 okt 2011
Berichten
61
Hallo,
ik heb een excelformulier gemaakt dmv comboboxen en textvelden, als alle verplichte velden zijn gevuld, kunnen ze op de cmb drukken van aanvragen. van dit formulier wordt dan een pdf gemaakt en moeten ze dit op hun eigen map bewaren, daarna wordt dit document verstuurd via outlook naar 1 vast mailadres. dit gaat verder allemaal goed, en wil ik ook zo houden. maar dan moet ik de gegevens op een ander exceldocument overtypen en dat wil ik eigenlijk niet.

dus moet er eigenlijk iets voordat het document wordt omgezet naar een pdf de gegevens in de comboboxen en andere velden de gegevens 1 centraal document worden gestuurd.
volgens mij moet dat wel kunnen, maar voor mij??? is er iemand die me hiermee helpen kan?

de invoer formulieren hebben ze dan allemaal op "eigen"schijf staan. we werken allemaal wel op 1 server.

code blad 1

Code: 
Private Sub Cmb_Verz_Click()

    'controle of alle tekstvelden zijn gevuld, behalve textbox Notitie
    If Me.Cob_Aanvrager.Text = "" Then
        MsgBox ("eigen naam vermelden!.")
    ElseIf Me.Txt_Adres.Text = "" Then
        MsgBox ("Straat naam vullen a.u.b.")
    ElseIf Me.Txt_Nr.Text = "" Then
        MsgBox ("Huisnummer invullen a.u.b.")
    ElseIf Me.Cob_Plaats.Text = "" Then
        MsgBox ("Plaatsnaam vermelden a.u.b.")
    ElseIf Me.Cob_Reden.Text = "" Then
        MsgBox ("Waarom is deze invent. nodig?, maak de keuze bij Reden Aanvraag")
    ElseIf Me.Cob_Reden.Text = "Mutatie" And Me.Txt_ddEI = "1-1-2014" Then
        MsgBox ("EI dd vermelden! ")
    ElseIf Me.Cob_Reden.Text = "Mutatie" And Me.Txt_Notitie = "" Then
        MsgBox ("vul in het notitieveld in waar je evt. een asbest toepassing hebt gezien of wat de reden is voor deze aanvraag ")
    ElseIf Me.Cob_Reden.Text = "Mutatie" And Me.Cob_Sleutel = "" Then
        MsgBox ("Is er een sleutelkluisje aanwezig? ")
    ElseIf Me.Cob_Reden.Text = "Renovatie" And Me.Txt_Bewoner = "" Then
        MsgBox ("Naam van bewoner invullen! ")
    ElseIf Me.Cob_Reden.Text = "Service verzoek" And Me.Txt_Bewoner = "" Then
        MsgBox ("Naam van bewoner invullen! ")
    ElseIf Me.Cob_Reden.Text = "Renovatie" And Me.Txt_Telnr = "" Then
        MsgBox ("Mobiel of vast tel.nr vermelden!! ")
    ElseIf Me.Cob_Reden.Text = "Service verzoek" And Me.Txt_Telnr = "" Then
        MsgBox ("Mobiel of vast tel.nr vermelden!! ")
    ElseIf Me.Cob_Besmetting.Text = "" Then
        MsgBox ("Is er sprak van een mogelijke besmetting?.")
    ElseIf Me.Cob_Reden.Text = "Calamiteit" And Me.Txt_Notitie = "" Then
        MsgBox ("Bij Calamiteit goed omschrijven in Notitieveld wat de reden is, waar de besmetting zit!! ")
    ElseIf Me.Txt_Internnr.Text = "" Then
        MsgBox ("Vul het interne ordernummer in ( ZS05)?.")
 
        Else
     Call RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail
     End If
End Sub

Private Sub Cob_Reden_Change()
If Me.Cob_Reden.Text = "Mutatie" Then
Txt_ddEI.Visible = True
Else
Txt_ddEI.Visible = False
End If
End Sub]

Module Create PDF
[Option Explicit

'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Workbook_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Worksheet_Or_Worksheets_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If

    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(ActiveSheet, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Selection_Range_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments


        'For a fixed range use this line
        FileName = RDB_Create_PDF(Range("A10:I15"), "", True, True)

        'For the selection use this line
        'FileName = RDB_Create_PDF(Selection, "", True, True)

        'For a fixed file name and overwrite it each time you run the macro use
        'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

        If FileName <> "" Then
            'Ok, you find the PDF where you saved it
            'You can call the mail macro here if you want
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End If
End Sub



Sub RDB_Sheet_Level_Names_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = Create_PDF_Sheet_Level_Names("addtopdf", "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'Create_PDF_Sheet_Level_Names("addtopdf", _
     '         "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub





Option Explicit

'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Workbook_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Worksheet_Or_Worksheets_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If

    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(ActiveSheet, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Selection_Range_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments


        'For a fixed range use this line
        FileName = RDB_Create_PDF(Range("A10:I15"), "", True, True)

        'For the selection use this line
        'FileName = RDB_Create_PDF(Selection, "", True, True)

        'For a fixed file name and overwrite it each time you run the macro use
        'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

        If FileName <> "" Then
            'Ok, you find the PDF where you saved it
            'You can call the mail macro here if you want
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End If
End Sub



Sub RDB_Sheet_Level_Names_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = Create_PDF_Sheet_Level_Names("addtopdf", "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'Create_PDF_Sheet_Level_Names("addtopdf", _
     '         "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub]



Module Functionsmodule


[Option Explicit

'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Workbook_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Worksheet_Or_Worksheets_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If

    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(ActiveSheet, "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub



Sub RDB_Selection_Range_To_PDF()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments


        'For a fixed range use this line
        FileName = RDB_Create_PDF(Range("A10:I15"), "", True, True)

        'For the selection use this line
        'FileName = RDB_Create_PDF(Selection, "", True, True)

        'For a fixed file name and overwrite it each time you run the macro use
        'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

        If FileName <> "" Then
            'Ok, you find the PDF where you saved it
            'You can call the mail macro here if you want
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End If
End Sub



Sub RDB_Sheet_Level_Names_To_PDF()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = Create_PDF_Sheet_Level_Names("addtopdf", "", True, True)

    'For a fixed file name and overwrite it each time you run the macro use
    'Create_PDF_Sheet_Level_Names("addtopdf", _
     '         "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub
wie kan me helpen?
 
Laatst bewerkt:
Als forumvervuiling/bladvulling kan dit tellen. :(

Lees eens de forumregels aub.
 
Je zou bijvoorbeeld een waarde van een textbox, combobox oid kunnen wegschrijven op de volgende manier.
Code: 
Range("A1").Value =  Cob_Aanvrager.Text
Je hoeft geen Me. te gebruiken.

Ik zou de opzet van de controle anders doen.
Stel dat men een aantal zaken vergeet in te vullen dan krijg men verscheidene malen een msgbox te zien.
M.i. is het beter om de knop voor het maken van de PDF inactief is en pas actief te gebruiken is als aan alle voorwaarden is voldaan.
Verder zou je met kleur aan kunnen geven wat nog moet worden ingevuld.
Mocht je toch met een msgbox willen werken dan zou ik 1 msgbox maken die een overzicht geeft van alle nog in te vullen velden.

Met vriendelijke groet,


Roncancio
 
Oke, maar is me nog niet duidelijk

Hallo,

dit aanvraag formulier wordt door diverse personen in een eigen mapje bewaard. dus zijn er een aantal van dit soor formulieren.
als dit formulier wort gevuld, wil ik dat de gegevens di is ingevuld wordt toegevoegd op een ander excelfromulier wat op een centrale plaats staat op de server.
zo hoef ik niet al die gegevens over te typen in dat formulier, is dat mogelijk?
de kans bestaat het aanvraag formulier onder een andere naam wordt opgeslagen.

Gr. René
 
Dat alle bestanden in een 'eigen mapje' staan speelt toch geen rol zolang er maar 1 centraal document is met 1 eenvormige naam.
Met Workbooks.Open open je dit centrale document en schrijft alle gegevens weg, slaat op en sluit af alvorens verder te gaan met de rest van je code(Pdf en Mailen).
Uiteraard moet deze aanpassing dan wel gebeuren in ieders eigen document.
 
maar wat moet ik waar naar verwijzen?

Hallo,

moet ik dan bij; Range("A1").Value = Cob_Aanvrager.Text, voor de Range het pad vermelden zoals bv, \\wbi-fs01\userhome\rene.vankooten\Documents\Asbestoverzicht ?
 
Bv.
Code: 
Private Sub CommandButton1_Click()
    Workbooks.Open "\\wbi-fs01\userhome\rene.vankooten\Documents\Asbestoverzicht\Naam centraal document.xlsx"
    With ActiveWorkbook
        .Sheets("Blad1").Range("A1").Value = Cob_Aanvrager.Text
        .Close True
    End With
End Sub

Je zal dan nog wel Bladnaam en/of celadres moeten aanpassen.
 
Het werkt, top dank je!

sorry heeft even geduurt, maar bedankt, voor je reactie en hulp!
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan