Hi,
Ever since the Win 10.0.15063 update I am unable to print a form in my Visual Basic 6 program (it works fine under Win 10.0.14393), so I am putting off updating some computers that use this Visual Basic program until I find a fix.
I use the command "frmPrint1.PrintForm", but the program gives me the error message Run-time error '482' Printer error. I do have printers installed and they do work. If I issue the command "frmAbout.PrintForm" and another form then it will print.
I have narrowed down the problem to an "OLE1.CreateLink tmpFile" code in the frmPrint1 form. If I comment this line out, then the rest of the form will print (just without the OLE Excel object).
I have tried different possible solutions I have found on the Internet, but none of them work. Does anyone know of a possible solution to fix this?
have you tried setting a specific printer to be the application printer, rather than just using the default printer?
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
have you tried setting a specific printer to be the application printer, rather than just using the default printer?
Yes, I have tried setting it to a specific printer (several different printers also), but that didn't fix the problem, I am still getting the error '482' Printer error.
I'm currently running VB6-SP6 on Windows 10 Home Version 1703, OS Build 15063.674. This seems to be the same version you say you're having problems with.
I did some testing and seem to be getting the same error that you're getting.
I played around with the OLE control and figured out that it only errors when it contains something. It doesn't seem to matter what it contains (Excel, Word, WordPad, etc). Furthermore, it doesn't seem to matter whether the file is linked or embedded. Also, I was just "right-clicking / Insert Object..." to get things into the OLE control, rather than doing it from code. Again, if the OLE is empty, all works fine, however, if anything is in it (embedded or linked), you get the error.
Also, all the behavior seems to be the same regardless of whether you're executing in the IDE or compiled.
I've attached a little project so that others could test on different versions of Windows. It's just a little project with a Form1, Command1, and OLE1:
The OLE1 has a very small embedded WordPad file in it, which is enough to show the error. Just as an FYI, this embedded WordPad file will be saved by stuffing it into the Form1.frx, so you'll get it in the attached project.
Here's the code I've got in Form1:
Code:
Option Explicit
Private Sub Command1_Click()
Me.PrintForm
End Sub
I'll be curious as to what Windows OSs this runs on and which it fails on.
I'm guessing that the OLE control is trying to get too fancy when the PrintForm is executed. As a possible work-around, you might execute some code that captures your form to the clipboard, and then print that image. I don't have code handy that does that, but I'm confident that I could work that out.
EDIT2: Actually, if you study that code a bit, you'll see that you can just print the PictureBox and stay away from the Clipboard entirely, and accomplish what you need.
EDIT3: Interesting, I tried the following code (with a Picture1 control added to the above Form1)...
Code:
Option Explicit
'
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CLIENT = &H4& ' Draw the window's client area
Private Const PRF_CHILDREN = &H10& ' Draw all visible child
Private Const PRF_OWNED = &H20& ' Draw all owned windows
Private Sub Command1_Click()
Dim ret As Long
'
Picture1.Width = Me.Width
Picture1.Height = Me.Height
Picture1.AutoRedraw = True
'
ret = SendMessage(Me.hwnd, WM_PAINT, Picture1.hDC, 0)
ret = SendMessage(Me.hwnd, WM_PRINT, Picture1.hDC, PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
'
Set Picture1.Picture = Picture1.Image
Printer.PaintPicture Picture1.Picture, 0, 0
End Sub
... and I don't get an error. The form prints, but the OLE control prints blank, even though it's clearly not. I looked at what was captured in the Picture1. You could see the OLE1, but the "asdf" text was gone. So, back to the drawing board.
EDIT4: There's clearly a way to do this because it works when I do Alt-PrintScreen and then paste to Paint.
Last edited by Elroy; Oct 12th, 2017 at 11:22 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Alright, I kept at it, and the following code seems to get it done. Again, I just added a PictureBox to the project attached to post #4. Also, it seems that you could do away with the PictureBox and just directly print the return of GetSnapshot. Just as an FYI, I borrowed code from here to get this going.
Code:
Option Explicit
'
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'
Private Type PICTDESC
cbSize As Long
pictType As Long
hIcon As Long
hPal As Long
End Type
'
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, ipic As IPicture) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal lScreenDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
'
Private Sub Command1_Click()
Dim pic As IPictureDisp
'
Picture1.Width = Me.Width
Picture1.Height = Me.Height
Picture1.AutoRedraw = True
'
Set pic = GetSnapshot(Me.hWnd)
Set Picture1.Picture = pic
'
'SavePicture Picture1.Picture, "c:\users\elroy\desktop\temp.bmp"
'
Printer.PaintPicture Picture1.Picture, 0, 0
End Sub
Function GetSnapshot(ByVal hWnd As Long) As IPictureDisp
Dim targetDC As Long
Dim hDC As Long
Dim tempPict As Long
Dim oldPict As Long
Dim wndWidth As Long
Dim wndHeight As Long
Dim pic As PICTDESC
Dim rcWindow As RECT
Dim guid(3) As Long
'
' provide the right handle for the desktop window
If hWnd = 0 Then hWnd = GetDesktopWindow
'
' get window's size
GetWindowRect hWnd, rcWindow
wndWidth = rcWindow.Right - rcWindow.Left
wndHeight = rcWindow.Bottom - rcWindow.Top
' get window's device context
targetDC = GetWindowDC(hWnd)
'
' create a compatible DC
hDC = CreateCompatibleDC(targetDC)
'
' create a memory bitmap in the DC just created
' the has the size of the window we're capturing
tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight)
oldPict = SelectObject(hDC, tempPict)
'
' copy the screen image into the DC
BitBlt hDC, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy
'
' set the old DC image and release the DC
tempPict = SelectObject(hDC, oldPict)
DeleteDC hDC
ReleaseDC GetDesktopWindow, targetDC
'
' fill the ScreenPic structure
With pic
.cbSize = Len(pic)
.pictType = 1 ' means picture
.hIcon = tempPict
.hPal = 0 ' (you can omit this of course)
End With
'
' convert the image to a IpictureDisp object
' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
' we use an array of Long to initialize it faster
guid(0) = &H7BF80980
guid(1) = &H101ABF32
guid(2) = &HAA00BB8B
guid(3) = &HAB0C3000
'
' create the picture,
' return an object reference right into the function result
OleCreatePictureIndirect pic, guid(0), True, GetSnapshot
End Function
Now, I'm not sure why, but that GetSnapshot function seems to grab a couple of extra pixels on the Left, Right, & Bottom. Maybe that's part of the non-client area, the part that Windows 10 uses for fading. I'm not sure. Here's a capture of what's actually printed. You can see the extra pixels.
I'd be a touch nervous about cropping those pixels, as then, it may work differently on older versions of Windows.
Good Luck,
Elroy
Last edited by Elroy; Oct 12th, 2017 at 11:46 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I'd be a touch nervous about cropping those pixels, as then, it may work differently on older versions of Windows.
Good Luck,
Elroy[/QUOTE]
---
Elroy,
I will try some of your suggestions.
You know, I am able to get only the OLE to print using the command: OLE1.ActiveSheet.PrintOut Copies:=1, Collate:=True
and I can get the Form to print if I comment out my code: OLE1.CreateLink tmpFile
I wish there was a way to put the two together to print on the same page.
Thanks,
Doug
Well, now I see you've got an Excel file loaded into your OLE control. With your OLE1.ActiveSheet.PrintOut statement, you're effectively using Excel automation (and the Excel VBA) to print your worksheet. That's basically outside the control of VB6, and handing the printing task to the Excel program (which is loaded into memory when you do this).
Under most circumstances when you use PrintForm, I wouldn't think all that is happening. But clearly, something has changed with the latest version of Windows 10.
If you'd care to show us, I'd be curious as to what all is on this form you're trying to print. Basically, a screen-shot posted here would be nice. Personally, I don't think I've ever used PrintForm for any production code. IMHO, it's just much better to format our own reports and print those. However, I know that everyone has their own way of doing things.
Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
[QUOTE=Elroy;5223739]Well, now I see you've got an Excel file loaded into your OLE control. With your OLE1.ActiveSheet.PrintOut statement, you're effectively using Excel automation (and the Excel VBA) to print your worksheet. That's basically outside the control of VB6, and handing the printing task to the Excel program (which is loaded into memory when you do this).
Under most circumstances when you use PrintForm, I wouldn't think all that is happening. But clearly, something has changed with the latest version of Windows 10.
If you'd care to show us, I'd be curious as to what all is on this form you're trying to print. Basically, a screen-shot posted here would be nice. Personally, I don't think I've ever used PrintForm for any production code. IMHO, it's just much better to format our own reports and print those. However, I know that everyone has their own way of doing things.
Take Care,
Elroy
---
Elroy,
Attached is the sample Form, I removed the page letterhead and footer information.
On my entry screen, we enter the data, and select an Excel file with the material specs we are providing a Submittal for
then when we go to print the form it takes the data from the fields, and replaces the OLE1 object with the Excel specs information, then prints.
I have not really seen an easier way to print a form like this then to use the .PrintForm option, I had seen some code where they loop through the items on a form and try to print it that way, but I didn't get that to work for me.
I would like to upgrade this application to Visual Basic 2017, but I have not seen the same type OLE1 option, maybe they handle this a different way now.
Doug
Elroy,
I don't actually use the OLE1.ActiveSheet.PrintOut statement, I just found this as a way to see if the OLE1 object would print, and it did using this.
In all previous version of Windows 98,XP,Vista,8,10.0.14393 I have been able to just use the .PrintForm option and it would print my form. Just trying to figure out what is different with it now, so I can fix it. Thanks.
Hmmm, well, if it were me, I'd tend to build an Excel worksheet that looked just like I wanted, and then print that (probably using Excel automation from VB6).
But this does seem like a well developed piece of software. I believe that takes you back to the ideas in my post #5. You may still have to work on those extra couple of pixels, but maybe with a borderless form, those problems will go away. With not much work, I'm relatively confident I could get it going. Worst case, you may have to check the Windows version to decide how to handle those extra few border pixels.
Good Luck,
Elroy
And, if you wind up needing the Windows version, here's a function to do that. It does use the winmgmts object, but it's not dependent on any API calls. Also, it circumvents any shims (compatibility options) you may have set for the executable.
Code:
Public Function WindowsVersion() As Long
'
' This is independent of any manifest or any compatibility settings.
'
' OS WindowsVersion return
' Windows 10 100
' Windows 8.1 63
' Windows 8.0 62
' Windows 7 61
' Windows Vista 60
' Windows XP 51
' Windows 2000 50
' -1 failed.
Static lVersion As Long
Dim SystemSet As Object
Dim System As Object
Dim s As String
Dim i As Long
'
If lVersion Then
WindowsVersion = lVersion
Exit Function
End If
'
On Error Resume Next
Set SystemSet = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
For Each System In SystemSet: s = System.Version: Next
'
i = InStr(s, ".")
s = Left$(s, i - 1) & mid$(s, i + 1)
i = InStr(s, ".")
If i Then s = Left$(s, i - 1)
lVersion = val(s)
WindowsVersion = lVersion
On Error GoTo 0
End Function
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.