Ik een Userform gemaakt met een Listbox die alle tabbladen herneemt. De button die ik gemaakt heb, met er voor zorgen, dat ik uit de keuzelijst een tabblad kan selecteren en die vervolgens in pdf kan verzenden via mail. De macro die ik geschreven heb voor button 2 laat enkel toe, dat ik het huidige tabblad kan versturen. Hieronder vinden jullie de reeds geschreven macro. Ik vermoed, dat dit zou moeten gebeuren via iloop?Wie kan mij helpen?
Met dank voor jullie reactie
--------------------------------------------------------------------------------------------------------------------
Deze werkt wel goed
Button 1
Private Sub CmdPrint_Click()
Dim iloop As Integer
For iloop = 1 To ListBox1.ListCount
If ListBox1.Selected(iloop - 1) = True Then
Sheets(ListBox1.List(iloop - 1, 0)).PrintOut
ListBox1.Selected(iloop - 1) = False
End If
Next
End Sub
--------------------------------------------------------------------------------------------------------------------
button 2 laat enkel toe, dat ik het huidige tabblad kan versturen
Private Sub Sendpdfbymail_Click()
'Do not forget to change the email ID
'before running this code
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim FileFullPath As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
TempFilePath = "D:\Documents" & " " & ActiveSheet.Name & ".pdf"
' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
'Complete path of the file where it is saved
FileFullPath = "D:\Documents" & " " & ActiveSheet.Name & "-" & ".pdf"
'Now Export the Activessheet as PDF with the given File Name and path
On Error GoTo err
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
'Now open a new mail
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = "xxxxxxxxxx@xxxxxxxxxxxxxxx.com"
.CC = ""
.BCC = ""
.Subject = "Prestatieblad"
.Body = ""
.Attachments.Add FileFullPath '--- full path of the pdf where it is saved
.Display 'or use .Send to show you the email before sending it.
End With
On Error GoTo 0
'Since mail has been sent with the attachment
'Now delete the pdf file from the temp folder
Kill FileFullPath
'set nothing to the objects created
Set NewMail = Nothing
Set OlApp = Nothing
'Now set the application properties back to true
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox ("Email Succesvol verstuurd")
Exit Sub
err:
MsgBox err.Description
End Sub
