Hi all,
Jon, To me it won't matter much weather the result is JPG or PNG.
However I have noticed an improvement in image quality when using PNG
instead of JPG (using a manual copy / paste method).
Let me explain the detail of what I intend on doing.
I am in the process of creating an extensive pricelist database and
quotation template. The quotation template already contains various
other macros.
In a nutshell, all that I require is a macro that takes the set range
of the quotation template and prepares an image file that is ready for
E-mailing. Different users will be utilizing different e-mail clients /
software, so I need to refrain from creating a 'ready-to-go email' in
something like Outlook, since obviously not everybody uses outlook...
I don't wish to use a macro that copies the set range to a chart and
then export it, as I have noticed a great reduction in image quality
when I tried doing this using the JPG format. I am willing to use other
formats, as long as it is a standard image format that can be opened by
the majority of image viewers. I wish to avoid using BMP's since the
result would be images (quotations) that would be unecesarily large in
size, thereby resulting in longer download / upload times.
The majority of code is complete, I just need to instruct MS Paint to
save the image to the desktop in JPG format, OR PNG (Since it does
provide a slight improvement on image quality, and a reduction in size)
I have added a control button to the main quotation template to which
the following macro is linked:
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Function FileExists(FileName As String) As Boolean
Dim iTemp As Integer
On Error Resume Next
On Error Resume Next
iTemp = GetAttr(FileName)
Select Case Err.Number
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select
On Error GoTo 0
End Function
Sub EMail_Prep()
Dim MSPaint, i As Integer
Dim PriceList As Workbook
Dim QuoteSht As Worksheet
Dim MailPrepConfirm As String
Dim Answer As String
Dim Wait As Long
On Error Resume Next
MailPrepConfirm = "Proceed with E-Mail prep?"
Answer = MsgBox(MailPrepConfirm, vbQuestion + vbYesNo, "E-MAIL
PREP")
If Answer = vbYes Then
Application.WindowState = xlMinimized
' Open Price Lists, unprotect sheet: "Quote"
If FileExists(ThisWorkbook.path & "\HC Price Lists.xlsm")
Then
Application.WindowState = xlMaximized
MsgBox ("This quotation has not been saved yet. Please
use the 'Save Quotation' button to first save the quotation before
running 'E-Mail Prep'." & _
" Click OK to exit."), vbExclamation, "E-MAIL PREP"
Application.WindowState = xlMinimized
GoTo EarlyExit
Else
' Close Price List if open
If FileExists(ThisWorkbook.path & "\..\Quote
Template\HC Price Lists.xlsm") Then
For Each PriceList In Workbooks
If PriceList.Name = "HC Price Lists.xlsm" Then
PriceList.Activate
If ActiveWorkbook.ReadOnly = True Then
ActiveWorkbook.Close
SaveChanges:=False
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Else
End If
Next
' Open Price List and MSPaint
MSPaint = Shell("mspaint.exe", 1)
'Delay until MS Paint is open
Do Until Wait <> 0
DoEvents
Wait = FindWindow("MSPaintApp", "untitled -
Paint")
Loop
Application.WindowState = xlMinimized
Set PriceList = Workbooks.Open(ThisWorkbook.path &
"\..\Quote Template\HC Price Lists.xlsm",
ignorereadonlyrecommended:=True)
Set QuoteSht = ThisWorkbook.Sheets("Quote")
QuoteSht.Activate
QuoteSht.Unprotect Password:=Workbooks("HC Price
Lists.xlsm").Worksheets("Belgotex").Range("W1")
' Copy range to MSPaint and protect QuoteSht
Range("A1:W67").CopyPicture
Appearance:=xlScreen, Format:=xlPicture
ActiveSheet.Protect Password:=Workbooks("HC
Price Lists.xlsm").Worksheets("Belgotex").Range("W1")
AppActivate MSPaint
SendKeys "^v", True
Else
MsgBox ("Unable to execute 'E-Mail Prep'. This
quotation has been moved from it's default location." & _
" To be able to run the 'E-Mail Prep' process, This
quotation first needs to be moved to it's default location." & _
" For quotations that have been saved previously,
the default location is the folder 'Quotes Issued'." & _
" For quotations that have not been saved
previously, the default location is the folder 'Quote Template'." & _
" If this problem persists, please contact DQS.
Click OK to exit."), vbCritical, "E-MAIL PREP"
GoTo EarlyExit
End If
End If
Application.WindowState = xlMaximized
Else
MsgBox "E-Mail prep cancelled. Click OK to exit.",
vbExclamation, "E-MAIL PREP"
GoTo EarlyExit
End If
EarlyExit:
Application.CutCopyMode = False
Set PriceList = Nothing
Set QuoteSht = Nothing
End Sub
Any help on the saving part???
Thx all
PS. Hector, thx for the help sofar, however, most of the links you
provided explains using PDF convertes or the 'Chart-method'.
