• 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.

Verzenden als pdf met vba

Status
Niet open voor verdere reacties.
L

Lschot

Gebruiker
Lid geworden
11 jan 2010
Berichten
47
Hoi allemaal;
Wekelijks moet mijn vader zijn bloedsuikerwaarden doormailen naar een vast e-mail adres, maar hij heeft totaal geen verstand van computers.
Om hem te helpen heb ik het bijgevoegde bestandje gemaakt wat ik helemaal beveilig zodat hij alleen de waarden in kan vullen die nodig zijn.
Met een knop naast het afdrukbereik moet hij het dan versturen.

Ik ben zover dat hij het verstuurd, maar helaas de hele werkmap.
Graag zou ik hebben dat alleen het afdrukbereik (cel a1 : i42) word verzonden, of nog beter als pdf.
Is dit mogelijk?

Ik heb al diverse site's bekeken en oplossingen geprobeerd OA van ron de bruin, maar ik kom er niet uit.

Wie kan mij helpen?
 

Bijlagen

  • voorbeeld.xlsm
    16,8 KB · Weergaven: 85
Gebruik dit stukje om de PDF te maken:
Code: 
    Sheets("Bloedsuikerwaarden").Range("A1:I42").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="C:\Diversen\Bloedsuikerwaarden.pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
 
Laatst bewerkt:
In Blad2(Bloedwaarden)
Code: 
Sub Mail_ActiveSheet()
'For Tips see: http://www.rondebruin.nl/win/winmail/div/tips.htm
'Working in Excel 2000-2016
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:I42").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Range of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail "ron@debruin.nl", _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
bron: http://www.rondebruin.nl/win/s1/div/mail4.htm

Het is niet mogelijk om met .sendmail een pdf te verzenden, daar heb je outlook(makkelijk) of CDO(moeilijk) voor nodig (zie ook ron de bruin).

Zie bericht#2, edmoor heeft de andere helft van de oplossing.
 
Laatst bewerkt:
Je kan dit gebruiken als je met Outlook wil mailen. Alleen even de rode gedeelten de juiste waarden geven:
Code: 
Sub Mail_ActiveSheet()
    Dim Pad As String
    Dim Bst As String
    Dim Otv As String
    
    Dim OutApp As Object
    Dim OutMail As Object
    
    Pad = "[COLOR="#FF0000"]C:\Diversen[/COLOR]"
    Otv = "[COLOR="#FF0000"]lschot@provider.nl[/COLOR]"
    Bst = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") & ".pdf"
    
    Sheets("Bloedsuikerwaarden").Range("A1:I42").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Pad & "\" & Bst, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .to = Otv
        .CC = ""
        .BCC = ""
        .Subject = "Bloedsuikerwaarden"
        .Body = "Bij deze de bloedsuikerwaarden"
        .Attachments.Add Pad & "\" & Bst
        .Send
    End With
    
End Sub

Als je dat met CDO wil doen dan laat het maar weten.
 
Laatst bewerkt:
Allemaal bedankt voor de reacties.
Het werkt, al kan ik het tabblad niet beveiligen, want dan krijg ik een foutmelding dat het blad beveiligd is.
Maar hier kan ik wel mee leven.
Door de vakjes die gebruikt mogen worden een kleur te geven denk ik dat mijn vader er wel mee overweg kan.
 
Ok dan. Succes :)
 
Volgens mij kun je het wel beveiligen, waarschijnlijk staat 1 van je velden nog op blokkeren. Kijk dit even goed na.
 
Het klopt inderdaad dat er velden geblokkeerd zijn, daar staan de gegevens van mijn vader in, en die mag hij niet kunnen veranderen.
Beveiligen valt dan helaas af, maar het komt zo ook wel goed denk ik.
Dank voor de reactie
 
Maar zijn er geen invulvelden geblokkeerd, want daar gaat het om. De informatieve velden mogen gewoon geblokkeerd zijn
 
Waarom het niet werkt met de beveiliging er op is me niet duidelijk.
Er wordt in principe niets veranderd in het bestand als je de code z'n werk laat doen.

Misschien zie ik iets over het hoofd, en dan haal je de beveiliging eraf met de code van @edmoor en onderstaande blauwe regels.
Code: 
Sub Mail_ActiveSheet()
    Dim Pad As String
    Dim Bst As String
    Dim Otv As String
    
    Dim OutApp As Object
    Dim OutMail As Object
     [COLOR=#0000FF]Sheets("Bloedsuikerwaarden").unprotect[/COLOR][COLOR=#0000FF][/COLOR]
    Pad = "[COLOR=#ff0000]C:\Diversen[/COLOR]"
    Otv = "[COLOR=#ff0000]lschot@provider.nl[/COLOR]"
    Bst = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") & ".pdf"
    
    Sheets("Bloedsuikerwaarden").Range("A1:I42").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Pad & "\" & Bst, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .to = Otv
        .CC = ""
        .BCC = ""
        .Subject = "Bloedsuikerwaarden"
        .Body = "Bij deze de bloedsuikerwaarden"
        .Attachments.Add Pad & "\" & Bst
        .Send
    End With
[COLOR=#0000FF]    Sheets("Bloedsuikerwaarden").protect  [/COLOR]
End Sub

Als het met een wachtwoord is beveiligd, neem je die mee in de code.
bv.

Sheets("Bloedsuikerwaarden").unprotect "jouw wachtwoord"
 
Met deze regel erin werkt het inderdaad, aan het eind van de tekst heb ik dezelfde regel er weer in gezet maar dan als protect.
Op deze manier beveiligd hij het werkblad gelijk weer, anders blijft het werkblad na het opslaan weer unprotected staan.
Ik ben helemaal blij, dank jullie allemaal voor het meedenken.
Ik ga deze vraag als opgelost zetten.:thumb::thumb::thumb:
 
Prima, die regel had ik er ook voor je in geplaatst (even scrollen).
Mooi dat het werkt.
 
Wel vreemd dat het werkt want die code wijzigt niets aan de inhoud van het document.
Desalniettemin, mooi dat het nu is zoals je het wilde hebben :)
 
Misschien doordat de 'IncludeDocProperties' op true staat?
 
Die optie leest alleen wat eigenschappen van het document om overeenkomende opties in de PDF mee te nemen maar wijzigt ook niets.
 
Ik schreef het ook al op #17:35.
Geen idee verder.
 
We gaan er denk ik niet achter komen, maar TS is blij :D
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan