Print an image from a userform

Phillip2

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
'____________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.


VBA Code:
'____________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.
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,974
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

Code:
'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

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows
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





VBA Code:
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

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows
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

BatCoder
Joined
Feb 28, 2002
Messages
1,400

ADVERTISEMENT

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.

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

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code:
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

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

BatCoder
Joined
Feb 28, 2002
Messages
1,400
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.

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

Phillip2

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows
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

BatCoder
Joined
Feb 28, 2002
Messages
1,400
Oh, you want to preview first.

Let's try this instead auto-print via Shell:
VBA Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,409
Messages
5,636,114
Members
416,899
Latest member
thealphaoverseer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top