MsgBox Printen/Mailen

[thst]

Hallo Allemaal,

Ben echt wanhopig, heb van alles geprobeerd, tot vannacht 2:30 uur bezig geweest maar kom er niet uit.

Met de MsgBox wil ik of Printen of Mailen in beide gevallen moet die wel PDF Creator uitvoeren.

Wie wil me helpen ?

Sub opslaan_en_mailen()


'If MsgBox("Wil Je Deze Woning Opslaan?", vbQuestion + vbYesNo) = vbYes Then
'If lAnswer = vbYes Then

'End If
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd

Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String

MyName = Range("d2").Value & ""
'/// Change the output file name here! ///
sPDFName = MyName & ".xls"
'"testPDF.pdf"
sPDFPath = "d:\test\"
'ActiveWorkbook.Path & Application.PathSeparator

'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"

'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm
.Subject = "Bijgaand de factuur, en bevestiging aflevering."
.To = Range("d5").Value & "" 'vul hier een mail adres in
.CC = ""
.Bcc = ""
.Body = Range("A1").Value & Range("D13").Value & vbNewLine & vbNewLine & Range("A2").Value & vbNewLine & Range("A3").Value & vbNewLine & vbNewLine & Range("A4").Value & vbNewLine & Range("A5").Value & vbNewLine & vbNewLine & Range("A6").Value & vbNewLine & Range("A7").Value & vbNewLine & Range("A8").Value & vbNewLine & vbNewLine & Range("A9").Value & vbNewLine & vbNewLine & Range("A10").Value

.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf") 'Factuur word verzonden.(0123456789.pdf)
.Attachments.Add sPDFPath & "\" & (Range("D7").Value) 'Bevestiging word verzonden (0123456789v.pdf)
'.Display
'.Save
.Send
End With
'End If

End Sub



Angela

 

[Warme bakkertje]

En hoe wil jij de gebruiker een keuze bieden als hij alleen maar een Ja en Neen-knop heeft ?

 

[lazovicpsv]

ja-printen
nee-niet printen

 

[thst]

Warme bakkertje,

Oh kan daar geen keuze van gemaakt worden ?

Net ja Mailen, en met Nee Printen of moet er nog een MsgBox Bij ??

Angela

 

[Hoornvan]

thst,

Ik weet niet of het al eens aan je gevraagd is maar plaats je code tussen de Tags.
Dit doe je zo, als je de code geplaatst heb selecteer je die en klik dan boven op #

 

[thst]

Det is wat ik op dit moment heb.

Zie bestand. Alleen het werkt dus nog niet goed.

Angela

 

[thst]

Beste Wim,

Tag, # ??

Ik snap echt niet wat je bedoelt.

Angela

 

[Hoornvan]

Dit uit mijn vorige bericht bedoel ik als je code hier op het forum zet moet je die handeling even doen.
Dan ziet het er zo uit.

Sub opslaan_en_mailen()
  'If MsgBox("Wil Je Deze Woning Opslaan?", vbQuestion + vbYesNo) = vbYes Then
  'If lAnswer = vbYes Then
End Sub

 

[Warme bakkertje]

Test de bijlage eens

 

[thst]

Warme bakkertje,

Ja dit werkt, alleen ik ben een stukje code vergeten.
Deze code plaatst een jpg afbeelding (logo en bedrijfsgegevens)
het bestand heet a2b.jpg en die afbeelding moet er komen als het gemaild wordt.
Als er geprint wordt moet de jpg afbeelding niet komen, omdat er afgedrukt wordt op voor gedrukt papier.

Ook hier heb ik zitten stoeien met a2b.jpg voor het mailen, en dezelfde code maar dan met een ander jpg a2b_leeg.jpg voor het printen.

Maar ik raak de weg kwijt met de sub's

Range("B13:F35").CurrentRegion.ClearContents
Dim ImgFileFormat As String, pic As Variant
On Error Resume Next
Application.DisplayAlerts = False
[B13:F35].Delete
Set rng = Range("B13:d33")
ImgFileFormat = "Image Files jpg (*.jpg),*.jpg,(*.bmp),others, tif (*.tif),*.tif"
Set pic = ActiveSheet.Pictures.Insert("E:\A2B4U\briefpapier.jpg")
If Not pic Is Nothing Then
With pic
.Height = rng.Height
.Width = rng.Width
.Left = rng.Left
.Top = rng.Top
.Placement = xlMoveAndSize
End With
Else: Exit Sub
End If
Application.DisplayAlerts = True
End Sub


Angela

 

[Warme bakkertje]

Waarom dan niet standaard dit logo op je factuur, en wanneer je wil printen deze gewoon even verbergen, printen, en terug zichtbaar maken ?

 

[thst]

Met welk commando verberg je het en met welk commando maak je hem weer zichtbaar ?

Angela

 

[Warme bakkertje]

Else
With ActiveSheet
    .Shapes("naam v/d afbeelding").Visible = False
    .PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"
    .Shapes("naam v/d afbeelding").Visible = True
End With

 

[Wigi]

Angela,

Het zou leuk zijn als je topics afhandelt vooraleer nieuwe topics te beginnen. Het wordt hier zo langs om meer een wirwar van topics met allemaal codes om te mailen, printen, als PDF op te slaan, met logo's erbij... Ik denk zelfs dat je jezelf een plezier doet door het allemaal overzichtelijker te houden, gezien de vragen die je allemaal stelt.

Wigi