Print an image from a userform

[Phillip2]

I have a userform with two pages. The second page only contains an image. This image changes depending on the customer's record number.
I am trying to write a macro that will scale this image down to fit on an standard 8 x 11 1/2 sheet and send the file to a printer.
The following is the macro that I'm using to place the image into the form.

'____________Page 2 Call Tree Frame________________________


'Inserts a picture of the Call Tree on Page two
callTree.Picture = LoadPicture("Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg")
End If
Next
End Sub

I have tried several things just to try and make it print the form. I really need for it to bring up a printer setup box, in case I need to change the orientation.
However, the best that I can get it to do is printing about half of the form's first page in a portrait orientation.

'____________Print Button________________________


Private Sub printButton_Click()
Dim RetStat
RetStat = Application.Dialogs(xlDialogPrinterSetup).Show
If RetStat Then Me.PrintForm
End Sub

All I actually want to print is the image that is on page two.

Any help would be appreciated.

 

[ranman256]

don't load image to a form , then print. Instead, print from its natural app.
The code below will do it for any file.

Paste this code into a module, and it will open ANY file in its native application.
usage: OpenNativeApp "c:\folder\file.pdf"
will open it in acrobat
and
OpenNativeApp "c:\folder\"
will open the folder

openNativeapp txtBox

'Attribute VB_Name = "modNativeApp"
'Option Compare Database
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&

Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String
r = StartDoc(psDocName)
If r <= 32 Then
'There was an error
Select Case r
Case SE_ERR_FNF
msg = "File not found"
Case SE_ERR_PNF
msg = "Path not found"
Case SE_ERR_ACCESSDENIED
msg = "Access denied"
Case SE_ERR_OOM
msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND
msg = "DLL not found"
Case SE_ERR_SHARE
msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
msg = "DDE Time out"
Case SE_ERR_DDEFAIL
msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY
msg = "DDE busy"
Case SE_ERR_NOASSOC
msg = "No association for file extension"
Case ERROR_BAD_FORMAT
msg = "Invalid EXE file or error in EXE image"
Case Else
msg = "Unknown error"
End Select
' MsgBox msg
End If
End Sub

 

[Phillip2]

Thank you so much for your help.
However, I'm missing something. See the Sub below.
I'm getting a compile error saying that reads only comments may appear after End Sub, End Function, or End Property.
I've tried rearranging my code, but I not doing something correctly. Can you please explain what I am missing?
Thanks

Private printButton_Click()

'my image folder is located at Y:\Phillip\CCX Applications\Images\
'and the jpg image's name is the number that is inside the TBrecord textbox

OpenNativeApp "Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg"
End Sub


'Attribute VB_Name = "modNativeApp"
'Option Compare Database
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&



Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String
r = StartDoc(psDocName)
If r <= 32 Then
'There was an error
Select Case r
Case SE_ERR_FNF
msg = "File not found"
Case SE_ERR_PNF
msg = "Path not found"
Case SE_ERR_ACCESSDENIED
msg = "Access denied"
Case SE_ERR_OOM
msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND
msg = "DLL not found"
Case SE_ERR_SHARE
msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
msg = "DDE Time out"
Case SE_ERR_DDEFAIL
msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY
msg = "DDE busy"
Case SE_ERR_NOASSOC
msg = "No association for file extension"
Case ERROR_BAD_FORMAT
msg = "Invalid EXE file or error in EXE image"
Case Else
msg = "Unknown error"
End Select
' MsgBox msg
End If
End Sub

 

[Phillip2]

I’m still having an issue getting this code to work. If anyone could please help me, I would appreciate it. I’m looking for a way to reach out to a folder and print a JPEG image. Thank you in advance.

 

[smozgur]

Please try to see what's going to happen if you use the following code line only. I can't test it at the moment but it should work in theory.

Shell ("cmd /c mspaint /p Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg")

 

[Dan_W]

Hi

There should be nothing above Option Explicit.

So you should move everything above that line to the very bottom. There, you should add Sub after the word Private:

Private Sub printButton_Click()

'my image folder is located at Y:\Phillip\CCX Applications\Images\
'and the jpg image's name is the number that is inside the TBrecord textbox

OpenNativeApp "Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg"
End Sub

 

[Phillip2]

Smozgur, thanks so much for responding.


At least it is doing something.
However, I'm getting an error reading Y:\Phillip\CCX.png was not found. The code is requesting a jpg not a png file. Why would it give this error?

 

[smozgur]

My bad - it is the spaces in the file path.
Please use 2 double quotes to surround the file path in the code. Just like below.

Shell ("cmd /c mspaint /p ""Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg""")

 

[Phillip2]

That did it! Thank you, I really appreciate it.

One last request while we are on the subject of printing. I was really wanting this to open the picture up with the printing setup. This way I might be able the change the orientation from Portrait to Landscape depending on which is best suited. If that is too much, I can live with this.

 

[smozgur]

Oh, you want to preview first.

Let's try this instead auto-print via Shell:

ThisWorkbook.FollowHyperlink "Y:\Phillip\CCX Applications\Images\" & TBrecord.Text & ".jpg"

It is supposed to open the file in the default photo viewer. I was able to test this, and it works good as I can see.